Texte préformaté’**********************
'Auteursrecht(C) 2023 Xarial Pty Limited
'Referentie: De componentenboom doorkruisen met behulp van de SOLIDWORKS API
"Licentie: Licentie
'**********************
Optie Expliciete
Dim swApp als SldWorks.SldWorks
Dim swModel als SldWorks.ModelDoc2
Dim deel als SldWorks.ModelDoc2
Dim SelMgr Als SldWorks.SelectionMgr
Dim swFeatMgr als SldWorks.FeatureManager
Dim path_complete As String 'chemin complet de la pièce
Dim myError zo lang mogelijk
Dim myWarning zo lang
Dim guillemet als snaar
Dim boolstatus als Booleaanse
Dim longstatus As Long, longwarnings As Long
Dim ext als snaar
Const INDENT_SYMBOL As String = " "
Sub hoofd()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If Not swModel Is Nothing Then
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Set SelMgr = Part.SelectionManager
Set swFeatMgr = Part.FeatureManager
Dim swRootComp As SldWorks.Component2
Set swRootComp = swModel.ConfigurationManager.ActiveConfiguration.GetRootComponent
' MsgBox "avant de rentrer dans la première boucle des enfants"
TraverseComponent swRootComp, ""
Else
MsgBox "Please open assembly"
Einde als
Einde Sub
Sub TraverseComponent(comp als SldWorks.Component2, inspringen als tekenreeks)
Dim vChildComps As Variant
vChildComps = comp.GetChildren
Dim i As Integer
For i = 0 To UBound(vChildComps)
Dim swChildComp As SldWorks.Component2
Set swChildComp = vChildComps(i)
Debug.Print indent & swChildComp.Name2 & " (" & swChildComp.GetPathName() & ")"
' Ouvre le fichier de la boucle
ext = Recht(swChildComp.GetPathName(), 6)
'si c'est un part
Als ext = « sldprt » Dan
'Debug.Print "Part " & swChildComp.GetPathName()
'swApp.OpenDoc6 "C:\VueLocalePDM\PDM\2-CREE\01-Bibliotheque\Pièces\Pièces 06\DOC-000024428.sldprt", 1, 0, "", 0, 0
swApp.OpenDoc6 swChildComp.GetPathName(), 1, 0, « », 0, 0
Anders
'ce n'est pas un prt'
Als ext = « sldasm » Dan
"////aSM
Set Part = swApp.OpenDoc6(swChildComp.GetPathName(), 2, 0, « », longstatus, longwarnings) '2 pou swDocASSEMBLY
Else
MsgBox "pas d'extension trouvée"
End If
Einde als
MsgBox "avant fermeture du fichier"
''ferme le fichier de la boucle
'swApp.CloseDoc Part.GetPathName
Set Deel = Niets
Next
Einde Sub
