---

Moin!

Wenn in einem ipt ein einziges Sweeping mit einem einzigen Profil ist, kann man dann die Fläche dieses Querschnittes irgendwie automatisch im VBA greifen und mit dem Volumen verrechnen und das in ein iProp eintragen?

Hintergrund ist, dass ich sämtliche versuchten Methoden der Kabellängenbestimmung über die Pfadlänge früher oder später als unzuverlässig verwerfen musste. Jetzt will ich es mal über das Volumen probieren.

------------------
Roland  
www.Das-Entwicklungsbuero.de

It's not the hammer - it's the way you hit!

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi,
bei einen Kabel kannst Du doch den Querschnitt  berechnen lassen und in einen Benutzerparameter eintragen. Dann in die Properties eintragen und weiter rechnen!

Gruß

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Dazu verwende ich iLogic. Im Beispiel unten, wird die Fläche von Skizze1 gemessen. Evtl. problematisch, wenn es mehrere geschlossene Konturen gibt. In meinem kleinen Test mit einem Rechteckrohr hat es aber korrekt funktioniert.

Code:

---

area = Measure.Area("Skizze1")
volume = iProperties.Volume

length = volume / area
iProperties.Value("Custom", "Test")  = Round(length,0)

---

Lässt sich bestimmt auch in VBA überführen.

------------------
Gruß KraBBy

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Zitat:

---

Original erstellt von Goose:
... bei einen Kabel kannst Du doch den Querschnitt  berechnen lassen

---

Ich wüsste nicht wie. Woher soll das Programm den Querschnitt wissen? Oder meinst Du das Du Kabel-und-Rohrleitunsdings von Autodesk? Das benutze ich nicht.

------------------
Roland  
www.Das-Entwicklungsbuero.de

It's not the hammer - it's the way you hit!

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Zitat:

---

Original erstellt von KraBBy:
...Fläche von Skizze1 ...

---

"Skizze1" heißt bei mir keine Skizze. Die werden alle ordentlich benannt. Zudem kommen sie oft per AK herein, da ist der Name erst recht anders.

Mehrere geschlossene Konturen gibt es darin dann meistens auch, wobei ich akzeptieren würde, für einen Automatismus die unbenutzen Konturen zu deaktivieren ("Konstruktionslinie").

Aber eindeutig ist doch:

Es gibt nur ein Sweeping. Und jedes Sweeping weiß genau, welche Skizze und welche Kontur darin es als Profil benutzt. Ist denn das nicht irgendwo in dem Objekt zu greifen?

Und ja, eigentlich kennt auch jedes Sweeping seinen Pfad, und wir hatten hier schon mal einen Code, der darauf zugegriffen hat, aber bei zusammengesetzten Pfaden wurde dann oft nur ein Teilstück gerechnet. Und es nützt ja nix, wenn man jedes Mal das Ergebnis zur Kontrolle selber nachrechnen muss.

------------------
Roland  
www.Das-Entwicklungsbuero.de

It's not the hammer - it's the way you hit!

[Diese Nachricht wurde von Roland Schröder am 19. Sep. 2017 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

also ich kann nicht nachvollziehen warum die Längenbestimmung über Pfadlänge nicht zuverlässig ist?
weil es mehrere Pfade bzw. Skizzen und jeweils nur ein Sweeping ist?

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Ja, warum es nicht funktioniert, weiß ich ja auch nicht.

Tatsache ist, dass der Code, den ich auf meiner Festplatte von den alten Versuchen noch gefunden habe, beim Ausprobieren ein falsches Ergebnis liefert. Vielleicht habe ich auch Müll gefunden. Ich weiß, dass es damals verschiedene Ansätze gab und einige davon nicht gut waren.

Das muss ich morgen noch mal in Ruhe und genauer ansehen, was dieser Code eigentlich tut. Dann poste ich ihn auch mal und dazu ein Beispiel.ipt.

Ganz davon abgesehen, ist aber der Sweepingpfad auch nicht zwingend gleich der abgewickelten Länge. Neutrale Faser und so. Eine Berechnung über Voumen und Querschnitt wäre in solchen Fällen viel genauer. Aber das ist meist tolerierbar - wenn denn die Pfadlänge korrekt ermittelt würde.

------------------
Roland  
www.Das-Entwicklungsbuero.de

It's not the hammer - it's the way you hit!

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

neuer Versuch, diesmal VBA

Im unteren Code-Abschnitt sollten die Elemente enthalten sein, nach denen Du gefragt hast: Fläche des Profils; Volumen; iProperty schreiben

Code:

---

Private Sub TrueSweepLength()
' kopiert aus Hilfe: True length of sweep feature API Sample
' Original

    'Set a reference to the active part document
    Dim oDoc As PartDocument
    Set oDoc = ThisApplication.ActiveDocument
   
    Dim oDef As PartComponentDefinition
    Set oDef = oDoc.ComponentDefinition
   
    ' Check to make sure a sweep feature is selected.
    If Not TypeOf oDoc.SelectSet.Item(1) Is SweepFeature Then
        MsgBox "A sweep feature must be selected."
        Exit Sub
    End If

    ' Set a reference to the selected feature.
    Dim oSweep As SweepFeature
    Set oSweep = oDoc.SelectSet.Item(1)
   
    ' Get the centroid of the sweep profile in sketch space
    Dim oProfileOrigin As Point2d
    Set oProfileOrigin = oSweep.Profile.RegionProperties.Centroid
   
    ' Transform the centroid from sketch space to model space
    Dim oProfileOrigin3D As Point
    Set oProfileOrigin3D = oSweep.Profile.Parent.SketchToModelSpace(oProfileOrigin)
   
    ' Get the set of curves that represent the true path of the sweep
    Dim oCurves As ObjectsEnumerator
    Set oCurves = oDef.Features.SweepFeatures.GetTruePath(oSweep.Path, oProfileOrigin3D)
   
    Dim TotalLength As Double
    TotalLength = 0
   
    Dim oCurve As Object
    For Each oCurve In oCurves
       
        Dim oCurveEval As CurveEvaluator
        Set oCurveEval = oCurve.Evaluator
       
        Dim MinParam As Double
        Dim MaxParam As Double
        Dim Length As Double
       
        Call oCurveEval.GetParamExtents(MinParam, MaxParam)
        Call oCurveEval.GetLengthAtParam(MinParam, MaxParam, Length)
       
        TotalLength = TotalLength + Length
    Next
   
    ' Display total sweep length
    MsgBox "Total sweep length = " & ThisApplication.UnitsOfMeasure.GetStringFromValue(TotalLength, kInchLengthUnits)
End Sub

---

Code:

---

Private Sub SweepLength()
' Kopie von oben, angepasst und erweiter

    'Set a reference to the active part document
    Dim oDoc As PartDocument
    Set oDoc = ThisApplication.ActiveDocument
   
    Dim oDef As PartComponentDefinition
    Set oDef = oDoc.ComponentDefinition

    ' Set a reference to the selected feature.  'geändert auf erstes SweepFeature
    Dim oSweep As SweepFeature
    'Set oSweep = oDoc.SelectSet.Item(1)
    If oDef.Features.SweepFeatures.Count > 0 Then
        Set oSweep = oDef.Features.SweepFeatures.Item(1)
    Else
        MsgBox "Aktives Dokument enthält kein Sweep-Feature!", vbOKOnly, "Abgebrochen"
        Exit Sub
    End If
   
    ' Get the centroid of the sweep profile in sketch space
    Dim oProfileOrigin As Point2d
    Set oProfileOrigin = oSweep.Profile.RegionProperties.Centroid
   
    ' Transform the centroid from sketch space to model space
    Dim oProfileOrigin3D As Point
    Set oProfileOrigin3D = oSweep.Profile.Parent.SketchToModelSpace(oProfileOrigin)
   
    ' Get the set of curves that represent the true path of the sweep
    Dim oCurves As ObjectsEnumerator
    On Error GoTo line
    Set oCurves = oDef.Features.SweepFeatures.GetTruePath(oSweep.Path, oProfileOrigin3D)
    ' das schlägt bei 3d-Skizzen fehl!?!
    On Error GoTo 0
   
    Dim TotalLength As Double
    TotalLength = 0
   
    Dim oCurve As Object
    For Each oCurve In oCurves
       
        Dim oCurveEval As CurveEvaluator
        Set oCurveEval = oCurve.Evaluator
       
        Dim MinParam As Double
        Dim MaxParam As Double
        Dim Length As Double
       
        Call oCurveEval.GetParamExtents(MinParam, MaxParam)
        Call oCurveEval.GetLengthAtParam(MinParam, MaxParam, Length)
       
        TotalLength = TotalLength + Length
    Next
   
line:
    On Error GoTo 0
   
    'zum Vergleich/Kontrolle die Länge des Pfades, der das Feature definiert
    Dim TotalLength2 As Double
    TotalLength2 = ThisApplication.MeasureTools.GetLoopLength(oSweep.Path)
   
    'zusätzlich Fläche des Profils ermitteln
    Dim dFl As Double
    dFl = oSweep.Profile.RegionProperties.Area
   
    ' Get the volume of the part. This will be returned in
    ' cubic centimeters.
    Dim dVolume As Double
    dVolume = oDoc.ComponentDefinition.MassProperties.Volume
    Dim strVolume As String
    strVolume = oDoc.UnitsOfMeasure.GetStringFromValue(dVolume, "mm mm mm")
   
    'Volumen durch Fläche dividieren -> sollte auch Länge des Sweeps liefern
    Dim dLen As Double
    Dim strLen As String
    If Not (dFl = 0) Then
        dLen = dVolume / dFl
        strLen = oDoc.UnitsOfMeasure.GetStringFromValue(dLen, kMillimeterLengthUnits)
    Else: MsgBox "Fehler! Fläche dFl = 0"
    End If
   
    ' in iProperty schreiben
    '
    ' Get the custom property set.
    Dim invCustomPropertySet As PropertySet
    Set invCustomPropertySet = oDoc.PropertySets.Item("Inventor User Defined Properties")
    ' Attempt to get an existing custom property named "Test_Length".
    On Error Resume Next
    Dim oProp As Property
    Set oProp = invCustomPropertySet.Item("Test_Length")
    If Err.Number <> 0 Then
        ' Failed to get the property, which means it doesn't exist
        ' so we'll create it.
        Call invCustomPropertySet.Add(strLen, "Test_Length")
    Else
        ' Got the property so update the value.
        oProp.Value = strLen
    End If
    On Error GoTo 0
   
    ' Display total sweep length
    Dim sMsg As String
    sMsg = "Total sweep length = " & ThisApplication.UnitsOfMeasure.GetStringFromValue(TotalLength, kMillimeterLengthUnits)
    sMsg = sMsg & vbCrLf & "Path length = " & ThisApplication.UnitsOfMeasure.GetStringFromValue(TotalLength2, kMillimeterLengthUnits)
    sMsg = sMsg & vbCrLf
    sMsg = sMsg & vbCrLf & "Area of Profile = " & ThisApplication.UnitsOfMeasure.GetStringFromValue(dFl, "mm mm")
    sMsg = sMsg & vbCrLf & "Part Volume = " & strVolume
    sMsg = sMsg & vbCrLf & "Vol/Area = " & strLen & vbTab & "-> iProp"
   
    MsgBox sMsg
End Sub

---

------------------
Gruß KraBBy

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hey, super, Danke!

Das macht (zumindest im ersten Test des angepassten Teils  ) alles richtig!     
Damit ist meine Bitte schon erfüllt: die restliche Anpassung an meine Vorlagen schaffe ich wohl allein.
Noch mal Danke dafür!

Und hier mal zum Vergleich der alte Code, der in derselben Datei nur ein Teilstück des Pfades rechnet:

Code:

---

Sub SweepLength()
    On Error Resume Next
    If ThisApplication.ActiveDocumentType <> kPartDocumentObject Then
        MsgBox "Geht nur im einzeln geöffneten Bauteil!"
        Exit Sub
    End If
       
    Dim oParams As Parameters
    Set oParams = ThisApplication.ActiveDocument.ComponentDefinition.Parameters
       
    Dim oParam As Parameter
    Set oParam = oParams.UserParameters("az")
   
    Dim dLength As Double
    dLength = Round(ThisApplication.MeasureTools.GetLoopLength(ThisApplication.ActiveDocument.ComponentDefinition.Features.SweepFeatures(1).Path.Item(1).SketchEntity), 0)
   
    If oParam Is Nothing Then
        Set oParam = oParams.UserParameters.AddByValue("az", dLength, Inventor.UnitsTypeEnum.kCentimeterLengthUnits)
    Else
        Set oParam = oParams.UserParameters("az")
        oParam.Value = dLength
    End If

    oParam.ExposedAsProperty = True
       
    MsgBox "Parameter az: " & oParam.Expression

---

 

------------------
Roland  
www.Das-Entwicklungsbuero.de

It's not the hammer - it's the way you hit!

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Zitat:

---

Dim dLength As Double
    dLength = Round(ThisApplication.MeasureTools.GetLoopLength(ThisApplication.ActiveDocument.ComponentDefinition.Features.SweepFeatures(1).Path.Item(1).SketchEntity), 0)

---

Wegen "Item(1)" wird nur die Länge des ersten Pfadstückes gemessen.
Es sollte sich auch das Object ".Path" als ganzes messen lassen:

Code:

---

Dim dLength As Double
    dLength = Round(ThisApplication.MeasureTools.GetLoopLength(ThisApplication.ActiveDocument.ComponentDefinition.Features.SweepFeatures(1).Path , 0)

---

------------------
Gruß KraBBy

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP