Pobrać pliki drzewa tworzenia z nomenklatury?

Out of category
21

Czy próbowałeś zrobić paczkę, przejść do montażu i przetestować go. Aby mieć pewność, że nie pochodzi z PDM.

22

Myślę, że pochodzi to z PDM, bardzo logicznie mam ten sam problem z zespołami z PDM, aby temu zaradzić, musisz otworzyć każdy zespół, a następnie wrócić do zespołu głowicy i uruchomić makro i wszystko działa, w przeciwnym razie to błąd ... Każdy komponent musi zostać załadowany do pamięci Solidworks.

Pozdrowienia

23

Dziękuję d.roger za te informacje. To bardziej skomplikowane niż myślałem... W skali maszyny składającej się z 4000 części lub więcej zajmie to dużo czasu!

Myślę, że będę musiał pozostać przy mojej obecnej metodzie, która jest dość żmudna, ale skuteczna.

 

Nadal sprawdzam poprawność kodu makra jako odpowiedzi na moje pytanie, może być przydatny dla innych.

1 polubienie
24

Oto inne podejście, które wykorzystuje drzewo projektowe, a nie same elementy.
Co powinno być bardziej kompatybilne z 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 polubienie
25

Doskonałe! Działa doskonale!

Właśnie dodałem małą wiadomość na końcu, aby wskazać, że eksport został wykonany

Msgbox "Export réalisé"

 

Bardzo dziękuję za pomoc JeromeP.

Czy przypadkiem możliwe jest, aby w każdym folderze w drzewie znajdował się tylko pierwszy poziom podzbioru?

26

Z przyjemnością.

Uwaga: Właśnie zmodyfikowałem , aby uwzględnić podkatalogi

27

Jest już świetny w stanie, ale brakowałoby 2 drobiazgów, aby idealnie pasował do moich potrzeb:

- ogranicz eksport do pierwszego poziomu podzbioru w każdym folderze (więcej nie potrzebuję)

- Nie eksportuj elementów, które są wykluczone z listy komponentów.

Czy myślisz, że jest to możliwe?

28

Wszystko jest możliwe.

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

Dodatkowo, jest idealny!

Nie wiem, jak Ci podziękować, to wszystko otworzy wiele perspektyw w moim biznesie!