Hallo VBA-Spezialisten,
ich habe folgendes Problem:
Für die Weitergabe von vereinfachten Baugruppen an unseren Lieferanten würde ich gerne meine Baugruppen über ein Makro automatisch vereinfachen bevor ich die Baugruppe über die STEP-Schnittstelle exportiere.
Es gibt im Inventor die Auswahlfunktion "interne Komponenenten auswählen" mit der über den Filter Bauteile auch alle Bauteile die im inneren der Baugruppe liegen selektiert werden. Problem ist nur, dass über die Baugruppenstruktur hinweg diese Bauteile nicht gelöscht werden können. Die selektierten Bauteile können nur ausgeblendet werden.
Um die internen Bauteile zu löschen würde ich nun ein Makro benötigen, das alle nicht sichtbaren Komponenten löscht. Meine ersten Versuche dieses Makros habe ich unten angefügt. EIn großes Problem stellt sich mit dem Löschen von Komponentenanordungen oder auch einzelnen Instanzen der Anordungen.
Eine Möglichkeit wäre zum Beispiel die gesamte Baugruppenstruktur zuerst auf eine Ebene zu ziehen (wie auch immer das möglich ist) und dann die Bauteile auszuwählen und zu löschen.
Ich wäre euch für jede Hilfe zu diesem Problem sehr dankbar.
Gruß
Christian Stadler
Public Sub DeleteAllInvisibleOccurrences()
' Set a reference to the assembly component definintion.
' This assumes an assembly document is open.
Dim oAsmCompDef As AssemblyComponentDefinition
Set oAsmCompDef = ThisApplication.ActiveDocument.ComponentDefinition
'Ask whether to ground the components
Dim grDecide As Boolean
If MsgBox("Bauteile fixieren?", vbYesNo + vbQuestion) = vbYes Then
grDecide = True
Else
grDecide = False
End If
If grDecide Then
' Ask whether to delete or suppress the existing constraints.
Dim bDelete As Boolean
If MsgBox("Abhängigkeiten löschen?", vbYesNo + vbQuestion) = vbYes Then
bDelete = True
Else
bDelete = False
End If
' Iterate through all of the constraints and perform the specified operation.
Dim oConstraint As AssemblyConstraint
For Each oConstraint In oAsmCompDef.Constraints
If bDelete Then
oConstraint.Delete
Else
oConstraint.Suppressed = True
End If
Next
' Iterate through all of the occurrences and ground them.
Dim oOccurrence As ComponentOccurrence
Dim ocOccurrencePattern As CircularOccurrencePattern
For Each oOccurrence In oAsmCompDef.Occurrences
oOccurrence.Grounded = True
Next
End If
' Iterate through all of the occurrences and delete invisible occurrences
For Each oOccurrence In oAsmCompDef.Occurrences
If oOccurrence.DefinitionDocumentType = kPartDocumentObject Then
If oOccurrence.Visible = False Then
oOccurrence.Delete
End If
End If
Next
End Sub
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP