Retrieve the files of the creation tree from the nomenclature?

Out of category
21

Have you tried to make a pack and go of the assembly and test it. To be sure that it doesn't come from the PDM.

22

I think it comes from the PDM, I very logically have the same problem with the assemblies from the PDM, to remedy this you have to open each assembly then go back to the head assembly and launch the macro and everything works otherwise it's the error ... Each component must be loaded into the Solidworks memory.

Kind regards

23

Thank you d.roger for this information. It's more complicated than I thought... On the scale of a machine of 4000 parts or more it will take a long time!

I think I'll have to stay with my current method, which is quite tedious but effective.

 

I still validate the macro code as an answer to my question, it can be useful to others.

1 Like
24

Here's a different approach that uses the design tree rather than the pieces themselves.
What should be more compatible with 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 Like
25

Excellent! It works perfectly!

I just added a little message at the end to indicate that the export has been done

Msgbox "Export réalisé"

 

Thank you very much for your help JeromeP.

Just by chance, is it possible to have only the first level of subset inside each folder in the tree?

26

With pleasure.

Note: I just modified to take into account the subdirectories

27

It's already great in the state, but 2 little things would be missing for it to perfectly match my needs:

- restrict the export to the first subset level in each folder (I don't need more)

- Do not export items that are excluded from the bill of materials.

Do you think this is possible?

28

Anything is 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

 

29

Extra, it's perfect!

I don't know how to thank you, all this will open up a lot of perspectives in my business!