Thema "Betreff: Inventor 2018 (VBA): GetMinimumDistance und mögliche Argumente" in Inventor - Deutsches Forum

Inventor 2018 (VBA): GetMinimumDistance und mögliche Argumente

fullevent — Tue, 26 Nov 2019 18:21:40 GMT

Hallo Zusammen,

ich bin dabei einige Regeln als Makros umzuschreiben und folgendes bereitet mir Kopfzerbrechen.

In vielen Regeln wird ein bestimmter Abstand gemessen und gerundet.

Math.Round(Measure.MinimumDistance("SubSubassembly:1", "Crashebene", "Subassembly:1", "YZ-Ebene"), 4)

Gibt es eine Möglichkeit diese Messung mit GetMinimumDistance durch zu führen oder ist hier Eigeninitiative gefragt?

Anbei auch die Beispieldatei zum Testen.

Grüße,

Aleks

Betreff: Inventor 2018 (VBA): GetMinimumDistance und mögliche Argumente

fullevent — Thu, 28 Nov 2019 09:02:55 GMT

Hallo Zusammen,

da es sich bei meiner Aufgabenstellung immer um die gleiche Messung handelt und lediglich die SubSubassembly in der Subassembly eine abweichende Position haben kann -je nach dem wann diese eingefügt wurde- helfe ich mir mit dem folgenden Code aus.

Sub test()
    Dim oDoc As AssemblyDocument
    Set oDoc = ThisApplication.ActiveDocument
    Dim oOccurrence As ComponentOccurrence
    Set oOccurrence = oDoc.ComponentDefinition.Occurrences.Item(1)
    Dim oTempOcc As ComponentOccurrence
    Dim entity1 As Object
    Dim entity2 As Object
        
        For Each oTempOcc In oOccurrence.Definition.Occurrences
            If oTempOcc.Name = "SubSubassembly:1" Then
                Set entity1 = oOccurrence.Definition.WorkPlanes.Item(1) 'YZ
                Set entity2 = oTempOcc.Definition.WorkPlanes.Item(4)
                Dim d1 As Double
                d1 = ThisApplication.MeasureTools.GetMinimumDistance(entity1.Plane, entity2.Plane)
                Debug.Print d1  'cm
            End If
        Next
End Sub

Fürs erste reicht mir das aus.

Grüße

Betreff: Inventor 2018 (VBA): GetMinimumDistance und mögliche Argumente

fullevent — Thu, 28 Nov 2019 10:46:48 GMT

Da ist irgendwie doch der Wurm drin..
Post 2 hat "zufällig" die richtige Distanz angezeigt. Die Messung war aber vermutlich fehlerhaft.

Anbei ein leicht veränderter Datensatz inkl. Code zum Ausprobieren.
Ich komm grad nicht weiter bzw. hab mich festgefahren.

Auf dem Screencast sieht man die manuelle Messung mit 200 mm und via Makro kommt immer 0 raus.

Sub test()
    Dim oDoc As AssemblyDocument
    Set oDoc = ThisApplication.ActiveDocument
    Dim oOccurrence As ComponentOccurrence
    Set oOccurrence = oDoc.ComponentDefinition.Occurrences.Item(1)
    Dim oTempOcc As ComponentOccurrence
    Dim entity1 As Object
    Dim entity2 As Object
        
        For Each oTempOcc In oOccurrence.Definition.Occurrences
            If oTempOcc.Name = "SubSubassembly:1" Then
                Set entity1 = oOccurrence.Definition.WorkPoints.Item(1).Point   'Mittelpunkt Subassembly
                Set entity2 = oTempOcc.Definition.WorkPoints.Item(1).Point      'Mittelpunkt SubSubassembly
                Dim d1 As Double
                d1 = ThisApplication.MeasureTools.GetMinimumDistance(entity1, entity2)
                Debug.Print d1  'cm
                Exit For
            End If
        Next
End Sub

Ich hoffe mir kann jemand meinen Fehler aufzeigen..

Screencast

Grüße,
Aleks

Betreff: Inventor 2018 (VBA): GetMinimumDistance und mögliche Argumente

Martin-Winkler-Consulting — Thu, 28 Nov 2019 17:22:16 GMT

@fullevent

Hallo Aleks,

ja da bist den Koordinatensystemen auf den Leim gegangen.

Du wertest in deinem Code jeweils den Ursprungspunkt der jeweiligen Assembly aus und der hat naturgemäß immer die Koordinate 0,0,0. Wenn ich nun auf diesen Punkten den Abstand ermittele ist der immer 0, egal wo ich die SubSubAssembly platziere.

Wie du die Lage der SubSubassembly in der Subassembly ermitteln kannst, kann du mal hiermit testen:

Sub test()
    Dim oDoc As AssemblyDocument
    Set oDoc = ThisApplication.ActiveDocument
    Dim oOccurrence As ComponentOccurrence
    Set oOccurrence = oDoc.ComponentDefinition.Occurrences.Item(1)
    Dim oTempOcc As ComponentOccurrence
    Dim entity1 As Object
    Dim entity2 As Object
        
        For Each oTempOcc In oOccurrence.Definition.Occurrences
            If oTempOcc.Name = "SubSubassembly:1" Then
                'Set entity1 = oOccurrence.Definition.WorkPoints.Item(1).Point   'Mittelpunkt Subassembly
                Set entity2 = oTempOcc.Transformation.Translation      'Mittelpunkt SubSubassembly
                'Set entity2 = oTempOcc.Definition.WorkPoints.Item(1).Point      'Mittelpunkt SubSubassembly
                Dim d1 As Double
                'd1 = ThisApplication.MeasureTools.GetMinimumDistance(entity1, entity2)
                d1 = entity2.Length

                Debug.Print d1  'cm
                Exit For
            End If
        Next
End Sub

Gruß Martin

Betreff: Inventor 2018 (VBA): GetMinimumDistance und mögliche Argumente

fullevent — Thu, 28 Nov 2019 17:42:01 GMT

Hallo @Martin-Winkler-Consulting,

vielen Dank für diesen Hinweis! Das werde ich mir heute Nacht nochmal genauer anschauen.

Aber dann verstehe ich (noch) nicht den Messbefehl. In meiner Muster Baugruppe möchte ich eigentlich den Abstand von der Crashebene zur YZ-Ebene des WKS Messen (oder Mittelpunkt an der Stelle).

Crashebene zum Ursprung der SubSubassembly sind 123,456 mm wenn ich mich richtig erinnere. Da kommen dann die 200 mm Versatz zwischen YZ-Ebene des Main-WKS zum Ursprung der SubSubassembly hinzu. In Summe 313,456 mm..

Ich dachte wenn ich als Entity1 die Crashebene und als Entity2 die YZ-Ebene des Main-WKS nehme, dann kommt das gewünschte Ergebnis 313,456 mm raus. Doch leider werden die 200 mm nie mitgemessen und ich lande immer bei den 123,456 mm.

Mir scheint als könnte ich das gar nicht in einen Messbefehl rein packen. Aber wie gesagt, ich probiere mich heute Nacht nochmal dran.

Ansonsten muss ich die zwei Werte separat ermitteln und dann addieren 🤔

Jedenfalls tausend Dank schon mal für den schlagenden Hinweis Martin!

Grüße,

Aleks

Betreff: Inventor 2018 (VBA): GetMinimumDistance und mögliche Argumente

fullevent — Thu, 28 Nov 2019 17:54:24 GMT

Beide Werte ermitteln und addieren funktioniert schon mal problemlos.. Vielleicht kann man das ja doch noch kompakt mit einem Messbefehl ermitteln lassen. Mal sehen..

Sub test()
    Dim oDoc As AssemblyDocument
    Set oDoc = ThisApplication.ActiveDocument
    Dim oOccurrence As ComponentOccurrence
    Set oOccurrence = oDoc.ComponentDefinition.Occurrences.Item(1)
    Dim oTempOcc As ComponentOccurrence
    Dim entity1 As Object
    Dim entity2 As Object
        
        For Each oTempOcc In oOccurrence.Definition.Occurrences
            If oTempOcc.Name = "SubSubassembly:1" Then
                Set entity1 = oOccurrence.Definition.WorkPlanes.Item(1).Plane   'YZ-Ebene WKS
                Set entity2 = oTempOcc.Definition.WorkPlanes.Item(4).Plane      'Crashebene SubSubassembly
                Dim d1 As Double
                d1 = ThisApplication.MeasureTools.GetMinimumDistance(entity1, entity2)
                Exit For
            End If
        Next
    d1 = d1 + oTempOcc.Transformation.Translation.Length
    Debug.Print d1  'cm
End Sub

Betreff: Inventor 2018 (VBA): GetMinimumDistance und mögliche Argumente

fullevent — Fri, 29 Nov 2019 07:25:06 GMT

Hallo Martin,

also mir ist leider nicht klar wie die .GetMinimumDistance Methode arbeitet bzw. was da genau passiert. Jedenfalls nicht das was ich erwarten würde.

Ich habe zum Test in der Main und der SubSubassembly je einen Arbeitspunkt in den Raum geworfen. Wenn ich mir die unterschiedlichen Ergebnisse zwischen manuelles Messen und dem Makro anschaue, dann kann ich die Methode leider nicht nachvollziehen.

Für meine aktuelle Anwendung reicht mir das Vorgehen aus meinem letzten Post. Vielen Dank nochmal für den entscheidenden Hinweis @Martin-Winkler-Consulting.

Gruß,

Aleks

PS.

Falls sich das noch jemand anschauen möchte oder mir sogar die Methode genauer erklären -also was wird da step-by-step genau gemacht- findet anbei den letzten Test-Stand.

Betreff: Inventor 2018 (VBA): GetMinimumDistance und mögliche Argumente

ferhatttcoskun — Fri, 29 Nov 2019 09:54:17 GMT

Let the text or mtext objects I select from the screen write to texbox1.text

write next selection to textbox2

write next selection to textbox3

write next selection to textbox4

If I click in an empty place, it will beep.

if I choose another object, msgbox"please select text or mtext object"

I want to do like this.
Can you help me, please

Thank you.