Moin,
wir haben uns heute morgen ein passendes Makro entwickelt, evtl. hilft es dir ja weiter
Public Sub bewegeKomponenteZumUrsprung()
Dim oDoc As Document
Dim oAsmCompDef As AssemblyComponentDefinition
Dim oAsmWorkPlane(1 To 3) As WorkPlane
Dim oOcc2 As ComponentOccurrence
Dim oPartPlane2 As WorkPlane
Dim oAsmPlane2 As WorkPlaneProxy
Dim oSelectSet As SelectSet
Dim i As Long
Set oDoc = ThisApplication.ActiveDocument
If oDoc.DocumentType <> kAssemblyDocumentObject Then
MsgBox "Dieses Makro funktioniert nur in einer Baugruppe! Dieses Makro fixiert eine Bauteil/Baugruppe im Ursprung der aktuellen Baugruppe.", vbCritical
Exit Sub
End If
Set oSelectSet = ThisApplication.ActiveDocument.SelectSet
' Validate the correct data is in the select set.
If oSelectSet.Count <> 1 Then
MsgBox "Es darf nur ein einzelnes Element ausgewählt sein!", vbCritical
Exit Sub
End If
'Debug.Print oSelectSet.Item(1).Type
If oSelectSet.Item(1).Type = 67113776 Then
' Die Nummer ist "hart verdrahtet", weil ich sonst keine andere Möglichkeit/Konstante gefunden habe.
Set oAsmCompDef = ThisApplication.ActiveDocument.ComponentDefinition
Set oOcc2 = oAsmCompDef.Occurrences.ItemByName(oSelectSet.Item(1).Name)
For i = 1 To 3
' Arbeitsebenen der Baugruppe auslesen
Set oAsmWorkPlane(i) = ThisApplication.ActiveDocument.ComponentDefinition.WorkPlanes.Item(i)
'Arbeitsebene des Bauteils/Baugruppe auslesen
Set oPartPlane2 = oOcc2.Definition.WorkPlanes.Item(i)
' Proxy Berechnung (Bauteil-Koords -> Baugruppen-Koords)
Call oOcc2.CreateGeometryProxy(oPartPlane2, oAsmPlane2)
' fluchtende Abhängigkeit vergeben
Call oAsmCompDef.Constraints.AddFlushConstraint(oAsmWorkPlane(i), oAsmPlane2, 0)
Next i
Else
MsgBox "Es muß ein Bauteil oder eine Baugruppe ausgewählt sein!", vbCritical
End If
End Sub
Das Makro hat noch zwei kleine Probleme:
1. Wenn es zweimal auf das gleiche Teil/Baugruppe ausgeführt wird, werden die Abhängigkeiten auch doppelt angelegt.
2. Es funktioniert nur für ein einzelnes Bauteil/Baugruppe. Aber das kann man bei Bedarf leicht anpassen
Ich hoffe, es läuft auch bei euch. Und falls jemand Fehler findet, bitte hier bescheid sagen.
Gruß
der Linkshänder
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP