Haben Sie versucht, ein Pack and Go aus der Montage zu machen und es zu testen? Um sicherzugehen, dass es nicht vom PDM kommt.
Ich denke, es kommt vom PDM, ich habe sehr logisch das gleiche Problem mit den Baugruppen aus dem PDM, um dies zu beheben, müssen Sie jede Baugruppe öffnen, dann zurück zur Kopfbaugruppe gehen und das Makro starten und alles funktioniert, sonst ist es der Fehler ... Jede Komponente muss in den Solidworks Speicher geladen werden.
Herzliche Grüße
Vielen Dank an d.roger für diese Informationen. Es ist komplizierter als ich dachte... In der Größenordnung einer Maschine von 4000 Teilen oder mehr wird es lange dauern!
Ich denke, ich werde bei meiner jetzigen Methode bleiben müssen, die ziemlich mühsam, aber effektiv ist.
Ich validiere immer noch den Makrocode als Antwort auf meine Frage, er kann für andere nützlich sein.
1 „Gefällt mir“
Hier ist ein anderer Ansatz, der den Designbaum anstelle der Teile selbst verwendet.
Was sollte besser mit PDM kompatibel sein?
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 „Gefällt mir“
Ausgezeichnet! Es funktioniert perfekt!
Ich habe nur eine kleine Nachricht am Ende hinzugefügt, um anzuzeigen, dass der Export abgeschlossen ist
Msgbox "Export réalisé"
Vielen Dank für deine Hilfe, JeromeP.
Ist es nur zufällig möglich, nur die erste Ebene der Teilmenge in jedem Ordner in der Struktur zu haben?
Mit Vergnügen.
Hinweis: Ich habe gerade geändert , um die Unterverzeichnisse zu berücksichtigen
Es ist bereits großartig in dem Staat, aber es würden 2 kleine Dinge fehlen, damit es perfekt zu meinen Bedürfnissen passt:
- Beschränken Sie den Export auf die erste Teilmengenebene in jedem Ordner (ich brauche keine mehr)
- Exportieren Sie keine Artikel, die von der Stückliste ausgeschlossen sind.
Glauben Sie, dass das möglich ist?
Alles ist möglich.
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, es ist perfekt!
Ich weiß nicht, wie ich Ihnen danken soll, all dies wird mir viele Perspektiven in meinem Geschäft eröffnen!