Problem mit dem Makro "Leere Variable"

Hallo, ich habe ein Problem in einem Makro auf einer einzigen von mehr als 20 Workstations für 2 Tage (bevor es perfekt funktionierte).
Die Variable Set swPart bleibt leer, anstatt wie zuvor aufgefüllt zu werden
Legen Sie swPart = swChildComp.GetModelDoc2() auf surrvol swPart = Nothing fest:

Sub TraverseComponent(swComp As SldWorks.Component2, nLevel As Long, catSelect As String)
    Dim vChilds As Variant, vChild As Variant
    Dim swChildComp As SldWorks.Component2
    Dim MyString As String
    Dim swCustPropMgr As SldWorks.CustomPropertyManager
    Set swApp = Application.SldWorks

    
    vChilds = swComp.GetChildren
    For Each vChild In vChilds
        Set swChildComp = vChild
        Dim FileName As String
        FileName = swChildComp.GetPathName
        Debug.Print "Part Name    : " & FileName
        FileName = Left(FileName, InStr(FileName, ".") - 1)
        FileName = Right(FileName, Len(FileName) - InStrRev(FileName, "\"))
        Debug.Print "Part Name    : " & FileName
        MyString = FileName
        Dim ActiveConfig As String
        ActiveConfig = swChildComp.ReferencedConfiguration
        Debug.Print "Configuration: " & ActiveConfig
        FileName = swChildComp.GetPathName
        If swChildComp.GetSuppression() <> swComponentSuppressionState_e.swComponentSuppressed Then
            Dim swIComp As IComponent2
            Set swIComp = swChildComp
            Dim notRepetition As Boolean
            notRepetition = swIComp.IsPatternInstance()
                Dim swPart As SldWorks.modelDoc2
                Set swPart = swChildComp.GetModelDoc2()
                'Récupère la catégorie de la configuration active
                Set swCustPropMgr = swPart.Extension.CustomPropertyManager(ActiveConfig) 'get properties
                categorie = swCustPropMgr.Get("Categorie") 'get categorie
                designation = swCustPropMgr.Get("Designation")
                'Si la catégorie de la config active est vide on récupère celle du document
                If categorie = "" Then
                    Set swCustPropMgr = swPart.Extension.CustomPropertyManager("") 'get properties
                    categorie = swCustPropMgr.Get("Categorie") 'get categorie
                    If designation = "" Then
                        designation = swCustPropMgr.Get("Designation") 'get categorie
                    End If
                End If
                
                Debug.Print "Catégorie: " & categorie
                    'If notRepetition = False Then
                        If catSelect = "FI" And notRepetition = False Then
                            folderName = "FI"
                            If (categorie = "Fourniture Industrielle" And Not (designation Like "STD*")) Or (categorie = "Tuyauterie") Or ((categorie = "Sans Catégorie") And (MyString Like "Bipod*")) Or ((categorie = "Sans Catégorie") And (MyString Like "Tripod*")) Then
                                compteur = compteur + 1
                                retVal = swChildComp.Select2(True, 0)
                            End If
                         ElseIf catSelect = "Visserie" And notRepetition = False Then
                            folderName = "Visserie"
                            'Debug.Print "Type:" & swPart.GetType
                            If (categorie = "Visserie") Or ((categorie = "Sans Catégorie") And (swPart.GetType = 2) And (Not MyString Like "Bipod*") And (Not MyString Like "Tripod*")) Then
                                compteur = compteur + 1
                                rRetVal = swChildComp.Select2(True, 0)
                            End If
                         ElseIf catSelect = "Reconductible" And notRepetition = False Then
                            folderName = "Reconductible"
                            'If categorie = "Reconductible" Then
                            If (categorie = "Reconductible") And (Not designation Like "STD*") Then
                                compteur = compteur + 1
                                retVal = swChildComp.Select2(True, 0)
                            End If
                         ElseIf catSelect = "Electricite" And notRepetition = False Then
                            folderName = "Electricité"
                            If categorie = "Electricite" Then
                                compteur = compteur + 1
                                retVal = swChildComp.Select2(True, 0)
                            End If
                          
                          ElseIf catSelect = "Produit" Then
                            folderName = "Produit"
                            If categorie = "Produit" Then
                                'Ligne pour exclure le composant de la nomenclature
                                swChildComp.SetExcludeFromBOM2 True, 2, 2
                                If categorie = "Produit" And notRepetition = False Then
                                    compteur = compteur + 1
                                    retVal = swChildComp.Select2(True, 0)
                                End If
                            End If
                        
                          ElseIf catSelect = "STD" And notRepetition = False Then
                            folderName = "STD"
                            If designation Like "STD*" Then
                                compteur = compteur + 1
                                retVal = swChildComp.Select2(True, 0)
                            End If
                        
                    'End If
            End If
            
        End If
        Debug.Print

    Next
    
End Sub

Hat jemand eine Erklärung für dieses sehr seltsame und plötzliche Verhalten (kein a priori Update)
Falls erforderlich, das vollständige Makro (über dem Teilcode)
CreateFolderByProperties.swp (118,5 KB)

Hallo

So eine Idee gibt es nicht. Wäre Swchild nicht auch leer?
Wenn Sie es Schritt für Schritt auf dem betreffenden Beitrag einführen, läuft es dann normal?

1 „Gefällt mir“

Hallo

Auch keine spontanen Ideen: Aber ich würde mir die folgenden Punkte ansehen.

  1. Die Art und Weise, wie die Baugruppe geöffnet wird.
    (sollte in " Resolved " sein und ist wahrscheinlich in " Lite ")?

  2. die fehlenden VB Supplements?
    (Es ist unwahrscheinlich, dass eine Fehlermeldung angezeigt wird)

  3. Registerkarte " Leistung " von Solidworks: Auflösung unter Baugruppen?
    (Vergleiche mit "funktionalen" Positionen)
    image

  4. … Die Lampe? (Ref: zu einer alten Werbung, deren Sponsor ich vergessen habe...)

2 „Gefällt mir“

Hallo @tous
Es erinnert mich an die Meldung " Das aufgerufene Objekt hat die Verbindung zu seinen Clients getrennt", die Tests lighten, delete, hide und isloaded() waren nicht ausreichend, es ist, als ob SW sie aus dem Speicher wirft (es könnte mit der Ressourcenoptimierung :stuck_out_tongue_winking_eye:zusammenhängen).
Ich schlage vor, eine Bedingung hinzuzufügen, wenn das Objekt leer ist, öffnen Sie das Dokument aus dem Komponentenpfad.

1 „Gefällt mir“

@sbadenis ... Haben Sie Feedback zu Ihren Untersuchungen?

@Cyril.f swchild die 2 Debugger nicht leer ist. Print zeigt die Variablen gut an.

@Maclane konnten die Ermittlungen aus Zeitmangel nicht vertieft werden.
Aber der Lichtmodus (1 Stück) verursacht diesen Fehler tatsächlich systematisch. (wie du dachtest)

Ich habe seine Einstellungen in seinem Beitrag erzwungen, um aufgelöst zu werden.

Ich werde wahrscheinlich etwas Code hinzufügen müssen, um zu überprüfen, ob das Ganze gelöst ist. (Im Falle des gleichen Problems auf einem anderen Arbeitsplatz)
Wenn jemand einen Code dazu hat, der die Arbeit erledigt, bin ich dafür!

Zweifellos eine Spur hier;
https://help.solidworks.com/2019/english/api/sldworksapi/Get_Component_State_Example_VB.htm

'---------------------------------------------------
' Preconditions:
' 1. Ensure that the specified assembly document
'    to open exists.
' 2. Open the Immediate window.
' 3. Run the macro.
'
' Postconditions:
' 1. Opens the assembly document.
' 2. Selects the subassembly.
' 3. Prints to the Immediate window:
'    * Paths to the assembly and subassembly documents
'    * Whether the component is hidden, fixed,
'      or suppressed
'    * Component's persistent ID
'    * Component's solving state
' 4. Examine the Immediate window.
'----------------------------------------------------

Option Explicit

Sub main()

    Dim swApp                       As SldWorks.SldWorks
    Dim swModel                     As SldWorks.ModelDoc2
    Dim swModelDocExt               As SldWorks.ModelDocExtension
    Dim swAssy                      As SldWorks.AssemblyDoc
    Dim swSelMgr                    As SldWorks.SelectionMgr
    Dim swComp                      As SldWorks.Component2
    Dim fileName                    As String
    Dim status                      As Boolean
    Dim errors                      As Long
    Dim warnings                    As Long

    Set swApp = Application.SldWorks

    ' Open assembly document
    fileName = "C:\Users\Public\Documents\SOLIDWORKS\SOLIDWORKS 2018\samples\tutorial\advdrawings\98food processor.sldasm"
    Set swModel = swApp.OpenDoc6(fileName, swDocASSEMBLY, swOpenDocOptions_e.swOpenDocOptions_Silent, "", errors, warnings)
    Set swModelDocExt = swModel.Extension
    

    ' Select subassembly
    status = swModelDocExt.SelectByID2("blade shaft-1@98food processor", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
    Set swSelMgr = swModel.SelectionManager
    Set swAssy = swModel
    Set swComp = swSelMgr.GetSelectedObjectsComponent3(1, 0)
    

    ' Print to the Immediate window the path and state of the
    ' selected component
    Debug.Print "File = " & swModel.GetPathName
    Debug.Print "  Component   = " & swComp.Name2
    Debug.Print "    Path           = " & swComp.GetPathName
    Debug.Print "    IsHidden       = " & swComp.IsHidden(True)
    Debug.Print "    IsFixed        = " & swComp.IsFixed
    Debug.Print "    GetSuppression = " & swComp.GetSuppression
    Debug.Print "    ID             = " & swComp.GetID
    ' 0 =  if subassembly is rigid
    ' 1 =  if subassembly is flexible
    ' -1 = selected component is a part component
    Debug.Print "    Solving        = " & swComp.Solving

End Sub

und genauer gesagt der Befehl " Lösen "

....    
Debug.Print "    Solving        = " & swComp.Solving
.....
1 „Gefällt mir“

Nach einem Schnelltest

Debug.Print " Lösen = " & swComp.Lösen

Funktioniert nicht für leichte oder gelöste Teile, sondern für starre, flexible oder einteilige Baugruppen.
Ich setze meine Nachforschungen fort!

1 „Gefällt mir“

Durch Hinzufügen dieses Codes erkennt es, ob eine oder mehrere Komponenten im Licht des Codes sind, und schlägt vor, sie zu lösen:
image

Und wenn die Person auf "OK" klickt, werden die Komponenten gelöst.
Wenn sie auf Abbrechen klickt, stürzt es wie zuvor bei der ungelösten Komponente ab, aber schlimmer für sie!

    Dim errors As Long
    errors = swAssy.ResolveAllLightWeightComponents(True)
    'Debug.Print ("All lightweight components resolved (0 = All components resolved)? " & errors)

Link zum API-Code
https://help.solidworks.com/2021/english/api/sldworksapi/resolve_all_components_fix_a_component_example_vb.htm

1 „Gefällt mir“