07-08-2023
04:11 AM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
07-08-2023
04:11 AM
Hi @aurel_e
I noticed your message asking about the Master LOD qty, and you may be aware that the BOM does not interact with the LOD's. In which case, if you want to do a part count based on part suppression you'll need to do a recursive count of all parts, then do exports based on these counts. The below will do that for you:
Sub Main() Dim errReport As New List(Of String) Dim oPath As String = ThisDoc.Path Dim doc As Document = ThisDoc.Document Dim oAsmDoc As AssemblyDocument = Nothing If TypeOf (doc) Is AssemblyDocument Then oAsmDoc = CType(doc, AssemblyDocument) End If Dim oAssyDef As AssemblyComponentDefinition = oAsmDoc.ComponentDefinition Dim oAsmName As String = System.IO.Path.GetFileNameWithoutExtension(oAsmDoc.FullFileName) Dim New_Folder_Path As String = System.IO.Path.Combine(oPath, oAsmName & " - LASER") If Not System.IO.Directory.Exists(New_Folder_Path) Then Try System.IO.Directory.CreateDirectory(New_Folder_Path) Catch ex As Exception MsgBox("Cannot create the following directory: " & New_Folder_Path) Exit Sub End Try End If Dim ExpSettingQuestion As Boolean = False If MessageBox.Show("Do you want to export Bend Lines?", "DXF Export Settings", MessageBoxButtons.YesNo) = vbYes Then ExpSettingQuestion = True End If Dim partTracker As New Dictionary(Of Document, PartTrackerData) RecursiveCount(oAsmDoc, partTracker) If partTracker.Count = 0 Then MsgBox("No sheet metal parts found", , "All Done") Exit Sub End If For Each part As KeyValuePair(Of Document, PartTrackerData) In partTracker Dim ptdata As New PartTrackerData ptdata = part.Value Dim oQty As Integer = ptdata.qty Dim oMaterial As String = ptdata.material Dim oThickness As Object = ptdata.thickness Dim Part_Name As String = System.IO.Path.GetFileNameWithoutExtension(part.Key.FullFileName) Dim a As String = part.Key.PropertySets.Item("Design Tracking Properties").Item("Stock Number").Value Dim filePath As String = System.IO.Path.Combine(New_Folder_Path, oMaterial & " - " & oThickness & "mm") If Not System.IO.Directory.Exists(filePath) Then System.IO.Directory.CreateDirectory(filePath) Dim filename As String = Part_Name & " - " & oMaterial & " " & oThickness & "mm - " & oQty & " off.dxf" Dim oFilename As String = System.IO.Path.Combine(filePath, filename) Make_DXF(part.Key, oFilename, ExpSettingQuestion, errReport) Next If Not errReport.Count = 0 Then System.IO.File.WriteAllLines(New_Folder_Path & "\" & oAsmName & " DXF Errors.txt", errReport.ToArray) End If MsgBox("DXF Export Complete", , "All Done") End Sub Private Sub RecursiveCount(doc As AssemblyDocument, ByRef partTracker As Dictionary(Of Document, PartTrackerData)) For Each occ As ComponentOccurrence In doc.ComponentDefinition.Occurrences If occ.Suppressed Then Continue For If TypeOf occ.Definition Is VirtualComponentDefinition Then Continue For Dim occdoc As Document = occ.Definition.Document If TypeOf occdoc Is PartDocument Then If occdoc.SubType <> "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Then Continue For Dim ptData As New PartTrackerData If partTracker.ContainsKey(occdoc) Then ptData = partTracker.Item(occdoc) Dim count As Integer = ptData.qty ptData.qty = count + 1 ptData.thickness = ptData.thickness ptData.material = ptData.material partTracker.Item(occdoc) = ptData Else ptData.qty = 1 ptData.thickness = occdoc.ComponentDefinition.Thickness.value * 10 ptData.material = occdoc.ComponentDefinition.Material.Name partTracker.Add(occdoc, ptData) End If ElseIf TypeOf occdoc Is AssemblyDocument Then RecursiveCount(occdoc, partTracker) End If Next End Sub Public Class PartTrackerData Public qty As Integer Public material As String Public thickness As Double End Class Sub Make_DXF(odoc As PartDocument, fullfilename As String, ExpSettingQuestion As Boolean, ByRef errReport As List(Of String)) Dim oCompDef As SheetMetalComponentDefinition = odoc.ComponentDefinition If oCompDef.HasFlatPattern = False Then Try oCompDef.Unfold() oCompDef.FlatPattern.ExitEdit() Catch ex As Exception errReport.Add("Cannot unfold the following file: " & System.IO.Path.GetFileNameWithoutExtension(fullfilename)) Exit Sub End Try End If Dim options As New List(Of String) Dim sOut As String = "" If ExpSettingQuestion Then Dim optionList As List(Of String) = New List(Of String) From { "AcadVersion=2004", "OuterProfileLayer=0", "InteriorProfilesLayer=0", "UnconsumedSketchesLayer=YELLOW", "UnconsumedSketchesLayerColor=255;255;0", "BendUpLayer=YELLOW", "BendUpLayerColor=255;255;0", "BendDownLayer=YELLOW", "BendDownLayerColor=255;255;0", "MarkSurfaceUpLayer=YELLOW", "MarkSurfaceUpLayerColor=255;255;0", "MarkSurfaceDownLayer=YELLOW", "MarkSurfaceDownColor=255;255;0" } options = optionList sOut = "FLAT PATTERN DXF?AcadVersion=2000" _ + "&InvisibleLayers=IV_TANGENT;IV_FEATURE_PROFILES;IV_ARC_CENTERS;IV_TOOL_CENTER;IV_TOOL_CENTER_DOWN;IV_FEATURE_PROFILES_DOWN" Else Dim optionList As List(Of String) = New List(Of String) From { "AcadVersion=2004", "OuterProfileLayer=0", "InteriorProfilesLayer=0", "UnconsumedSketchesLayer=YELLOW", "UnconsumedSketchesLayerColor=255;255;0", "", "" } options = optionList sOut = "FLAT PATTERN DXF?AcadVersion=2000" _ + "&InvisibleLayers=IV_TANGENT;IV_FEATURE_PROFILES;IV_ARC_CENTERS;IV_BEND;IV_BEND_DOWN;IV_TOOL_CENTER;IV_TOOL_CENTER_DOWN;IV_FEATURE_PROFILES_DOWN" End If For Each opt In options sOut = sOut & "&" & opt Next sOut = sOut & "?OFILE" Try oCompDef.DataIO.WriteDataToFile(sOut, fullfilename) Catch ex As Exception errReport.Add("Cannot export the following file: " & System.IO.Path.GetFileNameWithoutExtension(fullfilename)) End Try End Sub