07-07-2023
07:41 AM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
07-07-2023
07:41 AM
Hi @aurel_e
I've re-factored your code and included some error trapping relevant to your process. I've taken out the loop through AllReferencedDocuments as it was adding a lot of work to what is already taking place in the BOM rows.. unless I am missing something there? I also couldn't see any reference to Rev_Level so I have left it out. Shouldn't be much bother to adapt the below code to include it, what ever it is. Anyway, hope this gets you on the right path:
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)
Else
Exit Sub 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 errReport.Add("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 MyLOD_Name As String = oAssyDef.RepresentationsManager.ActiveLevelOfDetailRepresentation.Name If oAssyDef.RepresentationsManager.ActiveLevelOfDetailRepresentation.LevelOfDetail <> LevelOfDetailEnum.kMasterLevelOfDetail Then oAssyDef.RepresentationsManager.LevelOfDetailRepresentations("Master").Activate() End If Dim oBOM As BOM = oAssyDef.BOM oBOM.PartsOnlyViewEnabled = True Dim oBOMView As BOMView = oBOM.BOMViews.Item("Parts Only") Dim oBOMRows As BOMRowsEnumerator = oBOMView.BOMRows For Each oBOMRow As BOMRow In oBOMRows Dim rDoc As Document = oBOMRow.ComponentDefinitions.Item(1).Document If rDoc.SubType <> "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Then Continue For Dim oQty As Integer = oBOMRow.TotalQuantity Dim oMaterial As String = rDoc.ComponentDefinition.Material.Name Dim oThickness As Object = rDoc.ComponentDefinition.Thickness.value * 10 Dim Part_Name As String = System.IO.Path.GetFileNameWithoutExtension(rDoc.FullFileName) Dim a As String = rDoc.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(rDoc, oFilename, ExpSettingQuestion, errReport) Next oAssyDef.RepresentationsManager.LevelOfDetailRepresentations.Item(MyLOD_Name).Activate() 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 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) & vbCrLf & ex.ToString) End Try End Sub
Bear in mind this does not check if the dxf file already exists, and will instead overwrite it. You can do and If else statement around the dxf file name is so desired.
If System.IO.File.Exists(oFilename) Then 'do something else Else 'continue End If