---

Hallo zusammen,

gibt es eine Möglichkeit Toolbox-teile aus einer Baugruppe mit Unterbaugruppen auszulesen?

Möglicherweise Makro?

Danke schonmal,

Gruß Pete

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

---

vielleicht hilft dieser Thread,
war vor kurzem mal Thema

https://ww3.cad.de/foren/ubb/Forum2/HTML/033438.shtml

lg Martin

------------------
ich spiel noch immer gern mit Bauklötzen, nur sind sie jetzt teurer 

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

---

Das geht mit einer Kombination der Makros Traverse Assembly at Component Level Example (VBA) und Test for Toolbox Part Example (VBA)

Code:

---

Sub main()
   
    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim swConf As SldWorks.Configuration
    Dim swRootComp As SldWorks.Component2
    Dim fileName As String
    Dim errors As Long
    Dim warnings As Long

    Set swApp = CreateObject("SldWorks.Application")

    ' Open assembly
    'fileName = "C:\Users\Public\Documents\SOLIDWORKS\SOLIDWORKS 2020\samples\tutorial\dimxpert\advdimxpert\drum_pedal.sldasm"
    'Set swModel = swApp.OpenDoc6(fileName, swDocumentTypes_e.swDocASSEMBLY, swOpenDocOptions_e.swOpenDocOptions_Silent, "", errors, warnings)
    Set swModel = swApp.ActiveDoc
   
    Set swConf = swModel.GetActiveConfiguration
    Set swRootComp = swConf.GetRootComponent3(True)

    ' Traverse components
    TraverseComponent swRootComp, 1

End Sub

Sub TraverseComponent(swComp As SldWorks.Component2, nLevel As Long)

    Dim vChildComp As Variant
    Dim swChildComp As SldWorks.Component2
    Dim i As Long
    Dim ret As Long

    vChildComp = swComp.GetChildren
    For i = 0 To UBound(vChildComp)
        Set swChildComp = vChildComp(i)
        TraverseComponent swChildComp, nLevel + 1
        ret = swChildComp.GetModelDoc2.Extension.ToolboxPartType
        If ret > 0 Then
            Debug.Print swChildComp.Name2 & " <" & swChildComp.ReferencedConfiguration & ">"
            'Debug.Print "Toolbox part type as defined in swToolBoxPartType_e? " & ret
        End If
    Next i
   
End Sub

---

------------------
21 ist nur die halbe Antwort.

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

---

Servus,

ich hab das mal bei mir probiert,

er läuft bei

Code:

---

ret = swChildComp.GetModelDoc2.Extension.ToolboxPartType

---

in einen Fehler

Die Code Elemente die du verlinkt hast laufen auch in einen Fehler.

Mach ich da was falsch?

Gruß Pete

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

---

Ich habe jetzt mal in die oberste Baugruppe ein Toolbox Part gesetzt dieses wurde mir ausgegeben.

Wie kann ich denn jetzt noch alle unterbaugruppen durchsuchen?

Danke und Gruß :-)

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

---

Zitat:

---

Original erstellt von Pete85:
Wie kann ich denn jetzt noch alle unterbaugruppen durchsuchen?

---

Das Makro hier: https://ww3.cad.de/foren/ubb/Forum2/HTML/033442.shtml
hat ja funktioniert. Jetzt nur noch die Abfrage nach dem Toolbox-Teil gegen das virtualisieren tauschen...

------------------

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

---

Also ich versteh das nicht, bei mir läuft das Programm immer ein Stück weit aber läuft dann irgendwann bei

Code:

---

ret = swChildComp.GetModelDoc2.Extension.ToolboxPartType

---

in einen Fehler.

Das ist jetzt mal mein Code:

Code:

---

Option Explicit

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim boolstatus As Boolean

Const INDENT_SYMBOL As String = "    "

Sub main()

    Set swApp = Application.SldWorks
   
    Set swModel = swApp.ActiveDoc
   
    If Not swModel Is Nothing Then

        Dim swRootComp As SldWorks.Component2

        Set swRootComp = swModel.ConfigurationManager.ActiveConfiguration.GetRootComponent
   
        TraverseComponent swRootComp, 1

    Else

        MsgBox "Please open assembly"

    End If
   
End Sub

Sub TraverseComponent(swComp As SldWorks.Component2, nLevel As Long)

    Dim vChildComp As Variant
    Dim swChildComp As SldWorks.Component2
    Dim i As Long
    Dim ret As Long

    vChildComp = swComp.GetChildren
    For i = 0 To UBound(vChildComp)
        Set swChildComp = vChildComp(i)
        TraverseComponent swChildComp, nLevel + 1
        Debug.Print swChildComp.Name2 & " <" & swChildComp.ReferencedConfiguration & ">"
       
        ret = swChildComp.GetModelDoc2.Extension.ToolboxPartType
        If ret > 0 Then
            Debug.Print swChildComp.Name2 & " <" & swChildComp.ReferencedConfiguration & ">"
            'Debug.Print "Toolbox part type as defined in swToolBoxPartType_e? " & ret
        End If
    Next i
   
End Sub

---

Danke für eure Unterstzütung

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

---

Zitat:

---

...
in einen Fehler.

Das ist jetzt mal mein Code:

...

---

Also, wenn du uns nicht sagst in welchen Fehler das Programm läuft, ...

dann sagen wir dir auch nicht, dass es an unterdrückten Komponenten liegt ...

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

---

Moin,

sorry, das hab ich natürlich vergessen...

Code:

---

Laufzeitfehler '91'

OPbjektvariable oder With-Blockvariable nicht festgelegt

---

mit Option "Explicit" sollte das doch gar nicht möglich sein oder?

Danke und Grüße

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

---

Zitat:

---

dann sagen wir dir auch nicht, dass es an unterdrückten Komponenten liegt …

---

ist es leider auch nicht. läuft auch nicht durch, wenn nichts unterdrückt ist.

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

---

Hallo Pete,

also bei mir läuft das Macro problemlos durch bis eine Komponenten entweder Unterdrückt oder nur reduziert geladen ist, kannst du mal schauen bei welcher Komponente das Macro bei dir hängen bleibt (siehst du ja im Anzeigefenster/Direktbereich im Macroeditor).

Gruß
Bernd

------------------
--- Man muß nicht alles wissen, man muß nur wissen wo es steht ---

Staatlich anerkannte Deutschniete 

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

---

Moin,

ok, jetzt sehe ich das auch mit dem reduziert geladen,

wie kann ich denn das reduziert geladene und die Unterdrückung aufheben?

Hebe mich schon am Aufheben der Unterdrückung versucht... bin aber gnadenlos gescheitert

Danke schonmal...

Pete :-)

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

---

Zitat:

---

Hebe mich schon am Aufheben der Unterdrückung versucht... bin aber gnadenlos gescheitert...

---

dieses schon gelesen?

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

---

Hallo,

Ja Christian_W, das habe ich heute morgen entdeckt und auch gleich eingebaut.

Habe noch das Problem, dass unterdrückte Baugruppe nicht vollständig dargestellt werden.

Ich weiß, der Code ist nicht sehr elegant geschrieben. ich weiß aber momentan nicht ob es da etwas übersichtlicheres gibt.

ich möchte den Zustand (was die eingeblendeten und ausgeblendeten Elemente angeht) nicht verändern. muss diese aber einmal einblenden und vollständig darstellen, damit das Makro die Toolboxteile erkennt.

So lange keine unterdrückten Baugruppen eingeblendet werden müssen, läuft das Programm durch.
Mein Code sieht jetzt so aus...

Code:

---

Sub main()

    Set swApp = Application.SldWorks
   
    Set swModel = swApp.ActiveDoc
   
    If Not swModel Is Nothing Then

        Dim swRootComp As SldWorks.Component2
        Dim Status As Boolean

        Set swRootComp = swModel.ConfigurationManager.ActiveConfiguration.GetRootComponent
   
        TraverseComponent swRootComp, 1

    Else

        MsgBox "Please open assembly"

    End If
   
    Debug.Print "Ende"
   
End Sub

Sub TraverseComponent(swComp As SldWorks.Component2, nLevel As Long)

    Dim vChildComp As Variant
    Dim swChildComp As SldWorks.Component2
    Dim i, a As Long
    Dim ret As Long
  Dim Status As Boolean
  Dim name As String
  Dim nRetVal As Long
 

      vChildComp = swComp.GetChildren
    For i = 0 To UBound(vChildComp)
        Set swChildComp = vChildComp(i)
       
        TraverseComponent swChildComp, nLevel + 1
       

       
       
        If swComp.IsSuppressed Then
                   
                  nRetVal = swComp.SetSuppression2(swComponentResolved)
                                                 
                    ret = swComp.GetModelDoc2.Extension.ToolboxPartType
                        If ret > 0 Then
                            Debug.Print Now; swChildComp.Name2 & " <" & swChildComp.ReferencedConfiguration & ">"
                            'Debug.Print "Toolbox part type as defined in swToolBoxPartType_e? " & ret
                            ret = 0
                           
                            Else
                            End If
                       
                               
        nRetVal = swComp.SetSuppression2(swComponentSuppressed)
                   
                   
             
        Else
   
   
        ret = swComp.GetModelDoc2.Extension.ToolboxPartType
        If ret > 0 Then
                            Debug.Print Now; swChildComp.Name2 & " <" & swChildComp.ReferencedConfiguration & ">"
                            'Debug.Print "Toolbox part type as defined in swToolBoxPartType_e? " & ret
                            ret = 0
                           
                            Else
                            End If
                            ret = 0
       
        nRetVal = swComp.SetSuppression2(swComponentSuppressed)
        End If

           
           
           
           
           
            If swChildComp.IsSuppressed Then
           
 
                               
              nRetVal = swComp.SetSuppression2(swComponentFullyResolved)
                'Call delay
            nRetVal = swComp.SetSuppression(swComponentFullyResolved)
              nRetVal = swChildComp.SetSuppression2(swComponentResolved)
              'Call delay
           
              Debug.Print Now; " selektiert:" & swChildComp.Name2
                ret = swChildComp.GetModelDoc2.Extension.ToolboxPartType
        If ret > 0 Then
            Debug.Print Now; swChildComp.Name2 & " <" & swChildComp.ReferencedConfiguration & ">"
            'Debug.Print "Toolbox part type as defined in swToolBoxPartType_e? " & ret
            ret = 0
           
        End If
                nRetVal = swChildComp.SetSuppression2(swComponentSuppressed)
               
              Else
            Debug.Print Now; " selektiert:" & swChildComp.Name2
              ret = swChildComp.GetModelDoc2.Extension.ToolboxPartType
              If ret > 0 Then
            Debug.Print Now; swChildComp.Name2 & " <" & swChildComp.ReferencedConfiguration & ">"
            'Debug.Print "Toolbox part type as defined in swToolBoxPartType_e? " & ret
           
            ret = 0
           
           
        End If
       
        ret = 0
            End If

       
       
           
     
    Next i
   
End Sub

---

Für eure Hilfe bin ich euch weiterhin sehr dankbar :-)

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

---

Moin,

ich hab das mal weitergesponnen

Es klappt jetzt, so lange alle Dateien vorhanden sind, soweit ich beurteilen kann, echt super.

es werden auch die Fehler in die Log-Datei geschrieben.

das Problem ist jetzt noch, dass ich Dateien die nicht gefunden werden können nicht übergehen kann.

habt Ihr da eine Idee?

Code:

---

Dim i, tbp, n As Integer  ' Zähler der Komponente
Dim stamp As String
Dim Log As String
Dim oFile As Object
Dim fso As Object

Sub main2()
    ' wesentliche Teile von Stefan Berlitz http://solidworks.cad.de/mm_36.htm
    Dim swApp As Object
    Dim AssemblyDoc As Object
    Dim Configuration As Object
    Dim RootComponent As Object
    Dim Start, Ende, Dauer As String
   
   
   
   
    Debug.Print "Start"
   
   
    Start = Timer
    ' an SolidWorks anklinken und aktives Assembly holen
    Set swApp = Application.SldWorks
    Set AssemblyDoc = swApp.ActiveDoc
    ' Root-Komponente des Assemblies als Ausgangspunkt festmachen
    Set Configuration = AssemblyDoc.GetActiveConfiguration()
    Set RootComponent = Configuration.GetRootComponent()
   
    Log = Format(Now, "mm-dd-yyyy_HH-mm-ss")
    Log_erstellen Log
   

    swApp.CommandInProgress = True
    ' und jetzt rekursiv durch alle Ebenen
    i = 0
    tbp = 0
    If Not RootComponent Is Nothing Then
        TraverseComponent 1, RootComponent
    End If
   
   
    oFile.Close
   
    Ende = Timer
   
    Dauer = Ende - Start
   
    Debug.Print "Laufzeit: " & Dauer & "sek. Anzahl Toolboxteile: " & tbp & " und " & n & " N-Normteile von gesamt: " & i & " Teilen"
    Debug.Print "ENDE"
    n = 0
    tbp = 0
    i = 0
    swApp.CommandInProgress = False

End Sub

Private Function TraverseComponent(Level As Integer, swComp As Object)
    ' rekursive Routine, die alle Komponenten durchläuft

    Dim Children As Variant
    Dim Child As Object
    Dim ChildCount As Integer
    Dim Feature As Object
    Dim FeatureCreatedBy As String
    Dim ret As Boolean
   
   
    If swComp.IsSuppressed Then
        Call delay
       
                Debug.Print Now; "selektiert: " & swComp.Name2 & " <" & swComp.ReferencedConfiguration & ">"
               
                  nRetVal = swComp.SetSuppression2(swComponentResolved)
                Call delay
                nRetVal = swComp.SetSuppression2(swComponentResolved)
                Call delay
                    ret = swComp.GetModelDoc2.Extension.ToolboxPartType
                    On Error GoTo ErrorHandler
                        If ret = True Then
                            Debug.Print Now; "--->" & swComp.Name2 & " <" & swComp.ReferencedConfiguration & ">"
                            'Debug.Print "Toolbox part type as defined in swToolBoxPartType_e? " & ret
                            ret = False
                            tbp = tbp + 1
                           
                            stamp = Now & " : " & swComp.Name2
                            write_log stamp
                           
                            Else
                            End If

                           
                    If swComp.Name2 Like "N_*" Or swComp.Name2 Like "*/N_*" Then
                            n = n + 1
                           
                            stamp = Now & " : " & swComp.Name2
                            write_log stamp
                           
                            Else
                            End If
                           
                           
           
        Else
   
    Debug.Print Now; "selektiert: " & swComp.Name2 & " <" & swComp.ReferencedConfiguration & ">"
   
        ret = swComp.GetModelDoc2.Extension.ToolboxPartType
        On Error GoTo ErrorHandler
        If ret = True Then
                            Debug.Print Now; "--->" & swComp.Name2 & " <" & swComp.ReferencedConfiguration & ">"
                           
                            tbp = tbp + 1
                            ret = False
                           
                            stamp = Now & " : " & swComp.Name2
                            write_log stamp
                           
                            Else
                            End If
                            ret = False
                           
                            If swComp.Name2 Like "N_*" Or swComp.Name2 Like "*/N_*" Then
                           
                            stamp = Now & " : " & swComp.Name2
                            write_log stamp
                           
                            n = n + 1
                            Else
                            End If
                           
       
    If i < 0 Then
ErrorHandler:
stamp = Now & " : FEHLER : " & swComp.Name2
write_log stamp
Else
End If

        End If

       
        'stamp = Now & " : " & swComp.Name2
        'write_log stamp

               
    i = i + 1
   
   
   
    ' schauen, ob's ein Subassy ist und ggf. über die Kinder rüberschauen
    Children = swComp.GetChildren
    ChildCount = UBound(Children) + 1
    For j = 0 To (ChildCount - 1)
        Set Child = Children(j)
        TraverseComponent Level + 1, Child
    Next j
   

   
   

 
End Function

Sub delay()

Dim PauseTime, Start, Finish, TotalTime
'If (MsgBox("Press Yes to pause for 5 seconds", 4)) = vbYes Then
PauseTime = 1 ' Set duration.
Start = Timer ' Set start time.
Do While Timer < Start + PauseTime
DoEvents ' Yield to other processes.
Loop
Finish = Timer ' Set end time.
TotalTime = Finish - Start ' Calculate total time.
'MsgBox "Paused for " & TotalTime & " seconds"
'Else
'End
'End If
End Sub

Function Log_erstellen(name As String)
'Dim fso As Object
Dim pfad As String

pfad = "Da/Den/Pfad/Eintragen" & name & ".txt"    '<-- Ablagepfad angeben

Set fso = CreateObject("Scripting.FileSystemObject")
Set oFile = fso.CreateTextFile(pfad)
End Function

Function write_log(stamp As String)

Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")

'oFile.open

oFile.WriteLine stamp

'oFile.Close
'Set fso = Nothing
'Set oFile = Nothing

End Function

---

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

---

Hallo zusammen,

hat jemand eine Idee für die Lösung der Herausforderung?

kann ich nicht sagen, wenn Teil nicht gefunden wird oder eben Fehler, dann überspring das Element?

Besten dank schonmal 

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

---

Hallo Pete,

wenn du denn Status von unterdrückten Baugruppen nicht ändern möchtest, könntest du doch einfach die betroffene Baugruppe einfach öffnen und dort deine Abfrage drüber laufen lassen und nach Abschluss wieder zurück in die Hauptbaugruppe wechseln und dort weiter machen.

Gruß
Bernd

------------------
--- Man muß nicht alles wissen, man muß nur wissen wo es steht ---

Staatlich anerkannte Deutschniete 

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

---

Moin,

wie komme ich denn da am besten durch. ich hab da jetzt mal mit der OpenDoc6 Methode angefangen... merke aber dass er natürlich erstmal auf die geöffnete Baugruppe zugreifen will und die muss er ja nicht öffnen.

Wie kann ich sagen, wenn Dokument offen, dann weiter machen?

Danke.

Gruß Pete

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

---

Hallo Pete,

du brauchst wohl eine zweite Schleife innerhalb der Schleife die z.B. wenn Komponente = Baugruppe und Unterdrückt dann öffne Unterbaugruppe und mache das was in der äußeren Schleife auch gemacht wird, wenn er die Schleife durch hat die Unterbaugruppe wieder schließen und in der übergeordneten Schleife weiter machen.

Für die Schleife der Unterbaugruppe eigene Variablen vergeben sonst bekommts du am Ende Probleme wenn es wieder an das weiterarbeiten der Hauptbaugruppe geht.

Gruß
Bernd

------------------
--- Man muß nicht alles wissen, man muß nur wissen wo es steht ---

Staatlich anerkannte Deutschniete 

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

---

Er könnte auch den Level abfragen, bei 0 nichts machen.

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