---

Hallo Zusammen,

ich möchte gerne in einer geöffneten Baugruppe von jeder Komponente (nur die oberste Ebene) benutzerdefinierte Eigenschaften auslesen.
Hierzu habe ich ein Beispiel gefunden, welches leider kein Rückgabewert liefert.
Foren und Google konnten auch nicht weiterhelfen, vielleicht ist in diesem Forum jemand der sich damit bereits beschäftigt hat.
Hier der Code (geht noch reversiv durch):

Private Sub Button_get_2change_comps_Click()

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2

    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, ""

    Else

        MsgBox "Bitte eine Baugruppe öffnen!"

    End If
   
End Sub

Sub TraverseComponent(comp As SldWorks.Component2, indent As String)
    Dim ModelDoc As SldWorks.ModelDoc2
    Dim vChildComps As Variant
    Dim childlevel_temp
   
    Const INDENT_SYMBOL As String = "    "
   
    vChildComps = comp.GetChildren
   
    Dim i As Integer
    Dim swChildComp As SldWorks.Component2
   
    For i = 0 To UBound(vChildComps)
   
        Set swChildComp = vChildComps(i)
       
        Set ModelDoc = swChildComp.GetModelDoc2
        childlevel_temp = ModelDoc.GetCustomInfoValue("", "Artikel")
        Debug.Print indent & swChildComp.Name2 & " (" & swChildComp.GetPathName() & ")"
        Debug.Print indent & swChildComp.Name2 & " - Artikel: " & childlevel_temp
       
        TraverseComponent swChildComp, indent & INDENT_SYMBOL
       
    Next
   
End Sub

Gruß
Martin

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

---

Code:

---

Dim swApp As SldWorks.SldWorks

Sub main()
    Dim swModel As ModelDoc2
    Dim allComponents As Variant
    Dim swAssembly As AssemblyDoc
   
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swModelExt = swModel.Extension
   
    If (swModel Is Nothing) Then
        Exit Sub
    End If
               
    If (swModel.GetType = swDocPART) Then
        Exit Sub
    End If
   
    If (swModel.GetType = swDocASSEMBLY) Then
        Dim componentCount As Integer
        Dim component As Variant
        Dim swComponent2 As Component2
       
        Dim index As Integer
        Dim componentPath As String
        Dim msgReturn As Integer
       
        Set swAssembly = swModel
        allComponents = swAssembly.GetComponents(True)
        componentCount = swAssembly.GetComponentCount(True)
        msgReturn = swApp.SendMsgToUser2("Anzahl zu bearbeitender Dateien: " & componentCount & vbCrLf & "Wollen Sie fortfahren?", swMbQuestion, swMbYesNo)
       
        If (Not msgReturn = swMbHitYes) Then
            Exit Sub
        End If
                           
        For Each component In allComponents
            Set swComponent2 = component
            Dim swModelComponent As ModelDoc2
            Dim swCustomPropMgr As CustomPropertyManager
            Dim strValue As String
            Dim strResolvedValue As String
            Dim value As Integer
            Dim wasResolved As Boolean
           
            Set swModelComponent = swComponent2.GetModelDoc2
           
            If (Not swModelComponent Is Nothing) Then
                Set swCustomPropMgr = swModelComponent.Extension.CustomPropertyManager("")
                value = swCustomPropMgr.Get6("Material", False, strValue, strResolvedValue, wasResolved, False)
                componentPath = swModelComponent.GetPathName
               
   
                Debug.Print componentPath
                Debug.Print strValue
                Debug.Print strResolvedValue
                Debug.Print "Was resolved: " & wasResolved
            End If
        Next
    End If
End Sub

---

Hiermit könntest du schonmal durch alle Komponenten der obersten Ebene gehen. Wenn ich später noch Zeit habe, schaue ich mir auch das Auslesen der Eigenschaften noch an.

Eigenschaften werden jetzt ausgegeben. Allerdings wird zurzeit nur eine Konfiguration unterstützt.

[Diese Nachricht wurde von R3vo am 06. Jul. 2022 editiert.]

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

---

Hallo R3vo,

vielen Dank für die sehr schnelle Antwort / den Hinweis.

Ich hahe nun alles so am Laufen, wie angedacht.
Hier der Code:

Private Sub Button_get_2change_comps_Click()

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim assy_artnr

    Set swApp = Application.SldWorks
   
    Set swModel = swApp.ActiveDoc
    'assy_artnr = swModel.GetActiveConfiguration
    'Set swModel = swApp.GetModelDoc
    Set swConfig = swModel.GetActiveConfiguration
    Set swModelDocExt = swModel.Extension
    'Aus den konfigurationsspezifischen Eigenschaften die Artikel-ID auslesen
    Set swCustProp = swModelDocExt.CustomPropertyManager(swConfig.Name)
    bool = swCustProp.Get4("Artikel-ID", False, val, valout)
    Debug.Print "Value:                    " & val
    Debug.Print "Evaluated value:          " & valout
    Debug.Print "Up-to-date data:          " & bool
    assy_artnr = valout
   
    If Not swModel Is Nothing Then

        Dim swRootComp As SldWorks.Component2

        Set swRootComp = swModel.ConfigurationManager.ActiveConfiguration.GetRootComponent
        'Debug.Print swRootComp.Name, swRootComp.GetPathName
        TraverseComponent swRootComp, "", assy_artnr

    Else

        MsgBox "Bitte eine Baugruppe öffnen!"

    End If
   
End Sub

Sub TraverseComponent(comp As SldWorks.Component2, indent As String, bg_artnr_var)
    Dim ModelDoc As SldWorks.ModelDoc2
    Dim vChildComps As Variant
    Dim childlevel_temp
    Dim doublette_artikel
    Dim i As Integer, j As Integer, n As Integer, x As Integer
    Dim swChildComp As SldWorks.Component2
    Dim log_path, log_file_var, cfg_value
    Dim doubl_exist
    vChildComps = comp.GetChildren
   
    'zuerst lesen wir alle zu ersetzenden Artikel in ein Array ein
    doublette_artikel = Split(get_doubletten_as_list(), "|")
    ReDim ersatz_artikel(UBound(doublette_artikel) + 1)
   
    'Logdatei anlegen und zum schreiben öffnen
    'zuerst holen wir den Pfad zu den Loddateien
    cfg_value = Split(get_pathes(), "|")
    'Me.Verzeichnis_3D_Dateien = cfg_value(0)
    'Me.Verzeichnis_3D_Dateiliste = cfg_value(1)
    'Me.Verzeichnis_Log_Dateien = cfg_value(2)
    'Me.Verzeichnis_Doublettendatei = cfg_value(3)
    log_path = cfg_value(2)
    log_file_var = log_path & bg_artnr_var & "_zu-ersetzende-Artikel_" & (Split(get_user_act, "|")(0)) & "_" & Year(Now) & "-" & Right(Month(Now) + 100, 2) & "-" & Right(Day(Date) + 100, 2) & ".log"      '& "_" & Right(Hour(Time) + 100, 2) & "-" & Right(Minute(Time) + 100, 2) & ".log"
   

    Open log_file_var For Output As #1
    Print #1, "Log-Datei von " & Split(get_user_act, "|")(0) & " zu den in " & bg_artnr_var & " zu ersetzenden 3D-Modellen." & vbCrLf

   
    n = 0
    'Featurebaum durchlaufen
    For i = 0 To UBound(vChildComps)
   
        Set swChildComp = vChildComps(i)
        Set swModel = swChildComp.GetModelDoc
        Set swConfig = swModel.GetActiveConfiguration
        Set swModelDocExt = swModel.Extension
        'Aus den konfigurationsspezifischen Eigenschaften die Artikel-ID auslesen
        Set swCustProp = swModelDocExt.CustomPropertyManager(swConfig.Name)
        bool = swCustProp.Get4("Artikel-ID", False, val, valout)
        Debug.Print "Value:                    " & val
        Debug.Print "Evaluated value:          " & valout
        Debug.Print "Up-to-date data:          " & bool
       
        'In der Doublettenliste nachschauen, ob dieser Artikel ersetzt werden kann
        If valout <> "Artikel-ID" And Len(valout) > 3 Then
            For j = 0 To UBound(doublette_artikel) - 1
                If doublette_artikel(j) = valout Then
                    doubl_exist = False
                    For x = 0 To n
                        If ersatz_artikel(x) = doublette_artikel(j) Then
                            'Artikel ist bereits in der Liste, also kein weiteren Eintrag erstellen
                            doubl_exist = True
                            Exit For
                        End If
                    Next
                    If doubl_exist = False Then
                        ersatz_artikel(n) = doublette_artikel(j)
                        n = n + 1
                        Print #1, "Zu ersetzen: " & n & " - " & doublette_artikel(j) & vbCrLf
                    End If
                End If
            Next j
        End If
       
    Next i
    Close #1
    Shell "Explorer.exe " & log_file_var, vbNormalFocus
   
End Sub

Gruß
Martin

[Diese Nachricht wurde von Mssrs18 am 07. Jul. 2022 editiert.]

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