Hallo zusammen, ich habe ein Problem mit einem Makro das ich nicht gelöst bekomme. Vielleicht kann mir da ja wer helfen.
Ich möchte eine Baugruppe nach nach unterdrückten Bauteilen und Baugruppen durchsuchen und diese dann löschen.
Die Funktion von Solidworks mit alle unterdrücken Bauteile auswählen und dann von Hand löschen kann ich nicht verwenden, da in Unterbaugruppen unterdrückte Bauteile liegen können die aber da bleiben müssen.
Ich bekomme jedoch einen Fehler wenn ich die Extension von dem Modeldoc aufrufen möchte.
Der Fehler ist Laufzeitfehler '91':
Objektvariable oder With-Blockvariable nicht festgelegt
Option Explicit
Dim swApp As SldWorks.SldWorks
Sub main()
'Solidworksapplikation zuweisen
Dim swApp As SldWorks.SldWorks
Set swApp = Application.SldWorks
'Aktive Solidworksmodel zuweisen
Dim swModel As SldWorks.ModelDoc2
Set swModel = swApp.ActiveDoc
'ModelDocExtension aus dem ModelDoc laden
Dim swModelExt As SldWorks.ModelDocExtension
Set swModelExt = swModel.Extension
'Prüfen ob ein aktives Solidworksmodel vorhanden ist
If swModel Is Nothing Then
'Wenn kein aktives Model vorhanden ist dann Makro Ende
swApp.SendMsgToUser "Kein Dokument geladen!"
Exit Sub
End If
'Typ des aktiven Solidworksmodel zuweisen
Dim swDocType As Integer
swDocType = swModel.GetType
'Prüfen ob das Aktive Solidworksmodel ein Assambly ist
If swDocType <> swDocASSEMBLY Then
'Wenn kein Assambly dann Makro Ende
swApp.SendMsgToUser "Dieses Makro funktioniert nur in einem Assambly"
Exit Sub
End If
'Baugruppe deklarieren und zuweisen aus Model
Dim swAssembly As AssemblyDoc
Set swAssembly = swModel
'Alle Bauteile aus Baugruppe auslesen
Dim allComponents As Variant
allComponents = swAssembly.GetComponents(True) 'true = toplevel / false = childcomponents
'Alle Bauteile aus Baugruppe zählen
Dim componentCount As Integer
componentCount = swAssembly.GetComponentCount(True) 'true = toplevel / false = childcomponents
'Abfrage ob die Bearbeitung fortgesetzt werden soll
Dim msgReturn As Integer
msgReturn = swApp.SendMsgToUser2("Anzahl zu bearbeitender Dateien: " & componentCount & vbCrLf & "Wollen Sie fortfahren?", swMbQuestion, swMbYesNo)
'Abfrage der MsgBox wenn nicht weiterbearbeitet werden soll dann beende das makro hier
If Not msgReturn = swMbHitYes Then
Exit Sub
End If
'anzahl zu behaltender Bauteile
Dim intI As Integer
intI = 0
'anzahl zu löschender Bauteile
Dim intJ As Integer
intJ = 0
'Variable für bauteile in Baugruppe deklarieren
Dim component As Variant
For Each component In allComponents
'Variable für sld Components festgelegt und auslesen
Dim swComponent2 As SldWorks.Component2
Set swComponent2 = component
'Unterdrückungsstatus auslesen
Dim SuppressionState As Integer
SuppressionState = swComponent2.GetSuppression2
'variable für modeldoc der Componenten deklarierern und auslesen
Dim swModelComponent As SldWorks.ModelDoc2
Set swModelComponent = swComponent2.GetModelDoc2
' 'extension von modeldoc zuweisen
' Dim swCustomE As SldWorks.ModelDocExtension
' Set swCustomE = swModelComponent.Extension
'Abfrage ob bauteil unterdrückt ist wenn ja dann nächste schleife starten
If SuppressionState <> swComponentSuppressed Then
'String für Bauteilname
Dim swModelCompName As String
swModelCompName = swComponent2.Name2
Debug.Print swModelCompName
intI = intI + 1
Else
'extension von modeldoc zuweisen
Dim swCustomE As SldWorks.ModelDocExtension
Set swCustomE = swModelComponent.Extension '!!!!!!!!!Hier tritt der Fehler auf!!!!!!!!!!!!!!
Dim boolstatus As Boolean
boolstatus = swCustomE.SelectByID2(swComponent2.Name2, "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
swModel.EditDelete
intJ = intJ + 1
Debug.Print boolstatus
End If
Next
Debug.Print intI
Debug.Print intJ
End Sub
[Diese Nachricht wurde von Gentek am 18. Mrz. 2024 editiert.]
[Diese Nachricht wurde von Gentek am 18. Mrz. 2024 editiert.]
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP
Foren auf CAD.de (alle Foren)
| 
