---

Hallo ihr da draußen,

nach längerer Abstinenz habe ich mal wieder eine persönliche Wissensgrenze im VBA-Bereich gestoßen.

Und zwar versuche ich aktuell zwei Arbeitspunkte von Bauteilen einer Baugruppe mittels AddMateConstraint automatisch aufeinander zu setzen.

Im Internet habe ich dazu nichts finden können, lediglich um Arbeitsebenen aufeinander zu setzen. Dieses klappt auch, nur für Arbeitspunkt leider nicht.

In Anlehnung an die Herangehensweise bei Arbeitsebenen habe ich es natürlich auch über workpointproxy(s) versucht, jedoch leider ohne erfolg.

Bisher habe ich folgendes versucht:

Public Sub connect()

    Dim oDoc As Inventor.AssemblyDocument
    Set oDoc = ThisApplication.ActiveDocument
   
    Dim oCompDef As Inventor.ComponentDefinition
    Set oCompDef = oDoc.ComponentDefinition
   
    Dim oAsmCompDef As AssemblyComponentDefinition
    Set oAsmCompDef = ThisApplication.ActiveDocument.ComponentDefinition

    Dim oCompOcc As ComponentOccurrence
   
    Dim point_x, point_y, point_z As Double
    point_x = oCompDef.Occurrences(1).Definition.WorkPoints.Item(5).point.X
    point_y = oCompDef.Occurrences(1).Definition.WorkPoints.Item(5).point.Y
    point_z = oCompDef.Occurrences(1).Definition.WorkPoints.Item(5).point.Z
   

    Dim oPoint As WorkPoint
    Dim oMasterPoint, opostPoint As WorkPoint
   
    Set oMasterPoint = oCompDef.Occurrences(1).Definition.WorkPoints.Item(5)
  Set opostPoint = oCompDef.Occurrences(2).Definition.WorkPoints.Item(1)

    Call oAsmCompDef.Constraints.AddMateConstraint(oMasterPoint, opostPoint, 0)

End Sub

Hierzu habe ich in der Baugruppe 2 Bauteile abgelegt, Bauteil 1 besitzt neben dem Ursprung noch 4 weitere Arbeitspunkte.

Vielleicht habt ihr eine Idee?

Besten Dank im Voraus.

Liebe Grüße

Zeichnerschlumpf

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

---

Hallo

Keine Ahnung was du da als Adaption probiert hast, aber so geht's.

Code:

---

Public Sub connect()

    Dim oAsmCompDef As AssemblyComponentDefinition
    Set oAsmCompDef = ThisApplication.ActiveDocument.ComponentDefinition

    Dim oOcc1 As ComponentOccurrence
    Set oOcc1 = oAsmCompDef.Occurrences.Item(1)

    Dim oOcc2 As ComponentOccurrence
    Set oOcc2 = oAsmCompDef.Occurrences.Item(2)

    Dim oMasterPoint As WorkPoint
    Set oMasterPoint = oAsmCompDef.Occurrences(1).Definition.WorkPoints.Item(2)
   
    Dim oPostPoint As WorkPoint
    Set oPostPoint = oAsmCompDef.Occurrences(2).Definition.WorkPoints.Item(2)
   
    Dim oMasterPointProxy As WorkPointProxy
    Call oOcc1.CreateGeometryProxy(oMasterPoint, oMasterPointProxy)
   
    Dim oPostPointProxy As WorkPointProxy
    Call oOcc2.CreateGeometryProxy(oPostPoint, oPostPointProxy)
       
    Call oAsmCompDef.Constraints.AddMateConstraint(oMasterPointProxy, oPostPointProxy, 0)

End Sub

---

------------------
MfG
Ralf

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