Est ce que tu as essayer de faire un pack and go de l'assemblage et de tester la dessus. Pour être sûr que ca ne vienne pas du PDM.
Je pense que cela vient du PDM, j'ai très logiquement le même souci avec les assemblages issus du PDM, pour remédier à cela il faut ouvrir chaque assemblage puis retourner sur l'assemblage de tête et lancer la macro et tout fonctionne sinon c'est l'erreur ... Il faut que chaque composant soit chargé dans la mémoire de Solidworks.
Cordialement,
Merci d.roger pour ces infos. C'est plus compliqué que je ne le pensais... A l'échelle d'une machine de 4000 pièces ou plus ça va prendre un temps fou !
Je pense que je vais devoir rester avec ma méthode actuelle, assez fastidieuse mais efficace.
Je valide quand même le code de la macro comme réponse à ma question, ça pourra servir à d'autres.
1 « J'aime »
Voici une différente approche qui utilise l'arbre de design plutôt que les pièces elles-même.
Ce qui devrait être plus compatible avec le PDM
Option Explicit
Dim FilePath As String
Sub main()
FilePath = "C:\Temp\myBOM.TSV"
If Dir(FilePath) <> "" Then Kill FilePath
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim rootNode As SldWorks.TreeControlItem
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set rootNode = swModel.FeatureManager.GetFeatureTreeRootItem2(swFeatMgrPane_e.swFeatMgrPaneBottom)
If rootNode Is Nothing Then Exit Sub
TraverseNode rootNode, Mid(swModel.GetPathName, InStrRev(swModel.GetPathName, "\") + 1, InStrRev(swModel.GetPathName, ".") - InStrRev(swModel.GetPathName, "\") - 1)
End Sub
Private Sub TraverseNode(node As SldWorks.TreeControlItem, Rep As String)
Dim CompNode As SldWorks.Component2
If node.ObjectType = swTreeControlItemType_e.swFeatureManagerItem_Component Then
Debug.Print "Pièce: " & node.Text
If Not node.Object Is Nothing Then
Set CompNode = node.Object
WriteIntoFile Rep
End If
End If
Dim ChildNode As SldWorks.TreeControlItem
Set ChildNode = node.GetFirstChild
While Not ChildNode Is Nothing
If ChildNode.ObjectType = swTreeControlItemType_e.swFeatureManagerItem_Component Then
Set CompNode = ChildNode.Object
Dim CompName As String
CompName = CompNode.Name2
CompName = Mid(CompName, InStrRev(CompName, "/") + 1)
TraverseNode ChildNode, Rep & " > " & CompName
End If
If ChildNode.ObjectType = swTreeControlItemType_e.swFeatureManagerItem_Feature Then
Dim FeatNode As SldWorks.Feature
Set FeatNode = ChildNode.Object
If FeatNode.GetTypeName2 = "FtrFolder" Then
Debug.Print "Répertoire: " & ChildNode.Text
TraverseNode ChildNode, Rep & " > " & FeatNode.Name
End If
End If
Set ChildNode = ChildNode.GetNext
Wend
End Sub
Sub WriteIntoFile(logSTR As String)
Debug.Print " => " & logSTR
Dim FileNum As Integer
FileNum = FreeFile
Open FilePath For Append As #FileNum
Print #FileNum, logSTR
Close #FileNum
End Sub
1 « J'aime »
Excellent ! Ca fonctionne parfaitement !
J'ai juste ajouté un petit message à la fin pour signaler que l'export a été fait
Msgbox "Export réalisé"
Merci beaucoup pour ton aide JeromeP.
Juste à tout hasard, est-il possible de n'avoir que le premier niveau de sous-ensemble à l'intérieur de chaque dossier de l'arborescence ?
Avec plaisir.
Note: Je viens de modifié pour prendre en compte les sous répertoires
C'est déjà super dans l'état, mais il manquerait 2 petites choses pour que cela corresponde parfaitement à mon besoin :
- restreindre l'export au premier niveau de sous-ensemble dans chaque dossier (je n'ai pas besoin de plus)
- ne pas exporter les éléments exclus de la nomenclature.
Penses-tu que cela soit possible ?
Tout est possible.
Option Explicit
Dim FilePath As String
Sub main()
FilePath = "C:\Temp\myBOM.TSV"
If Dir(FilePath) <> "" Then Kill FilePath
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim rootNode As SldWorks.TreeControlItem
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set rootNode = swModel.FeatureManager.GetFeatureTreeRootItem2(swFeatMgrPane_e.swFeatMgrPaneBottom)
If rootNode Is Nothing Then Exit Sub
TraverseNode rootNode, 0, Mid(swModel.GetPathName, InStrRev(swModel.GetPathName, "\") + 1, InStrRev(swModel.GetPathName, ".") - InStrRev(swModel.GetPathName, "\") - 1)
End Sub
Private Sub TraverseNode(node As SldWorks.TreeControlItem, level As Integer, Rep As String)
Dim CompNode As SldWorks.Component2
If node.ObjectType = swTreeControlItemType_e.swFeatureManagerItem_Component Then
'Debug.Print "Pièce: " & node.Text
If Not node.Object Is Nothing Then
Set CompNode = node.Object
WriteIntoFile Rep
End If
End If
Dim ChildNode As SldWorks.TreeControlItem
Set ChildNode = node.GetFirstChild
While Not ChildNode Is Nothing
If ChildNode.ObjectType = swTreeControlItemType_e.swFeatureManagerItem_Component Then
Set CompNode = ChildNode.Object
Dim CompName As String
CompName = CompNode.Name2
CompName = Mid(CompName, InStrRev(CompName, "/") + 1)
If level < 1 And CompNode.ExcludeFromBOM = False Then
TraverseNode ChildNode, level + 1, Rep & " > " & CompName
End If
End If
If ChildNode.ObjectType = swTreeControlItemType_e.swFeatureManagerItem_Feature Then
Dim FeatNode As SldWorks.Feature
Set FeatNode = ChildNode.Object
If FeatNode.GetTypeName2 = "FtrFolder" Then
'Debug.Print "Répertoire: " & ChildNode.Text
TraverseNode ChildNode, level, Rep & " > " & FeatNode.Name
End If
End If
Set ChildNode = ChildNode.GetNext
Wend
End Sub
Sub WriteIntoFile(logSTR As String)
Debug.Print " => " & logSTR
Dim FileNum As Integer
FileNum = FreeFile
Open FilePath For Append As #FileNum
Print #FileNum, logSTR
Close #FileNum
End Sub
Extra, c'est parfait !
Je ne sais pas comment te remercier, tout ça va ouvrir plein de perspectives dans mon activité !