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)