Hi all,
I have the ilogic rule below to export flat pattern of sheet metal parts.
I have found it online and made some mods. Have been used it for months and just now spotted it don't work properly when in the assembly there are sheet metal parts with problems (multi body parts, or parts that cannot flatten). It looks the Ilogic rules stops. It doesn't export the parts with problems (as expected), but misses good parts as well.
I would like to modify so on error to keep going and at the end to show a txt file with the list of the problematic files.
Sub Main()
oPath = ThisDoc.Path
Dim oAsmDoc As AssemblyDocument = ThisDoc.Document
Dim AssyDef As AssemblyComponentDefinition
AssyDef = oAsmDoc.ComponentDefinition
Dim oAsmName = oAsmDoc.DisplayName.Replace(".iam", "")
Dim New_Folder_Path As String = oPath & "\" & oAsmName & " - LASER"
My.Computer.FileSystem.CreateDirectory(New_Folder_Path)
Dim oMaterial As String
ExpSettingQuestion = MessageBox.Show("Do you want to export Bend Lines?", "DXF Export Settings", MessageBoxButtons.YesNo)
For Each doc As Document In oAsmDoc.AllReferencedDocuments
If doc.SubType = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Then
Dim RefOccs As ComponentOccurrencesEnumerator
RefOccs = AssyDef.Occurrences.AllReferencedOccurrences(doc)
If RefOccs.Count >0 Then
Try
oMaterial = doc.ComponentDefinition.Material.Name
oThickness = doc.ComponentDefinition.Thickness.value*10
Material_Path = New_Folder_Path & "\" & oMaterial & " - " & oThickness & "mm"
Try
My.Computer.FileSystem.CreateDirectory(Material_Path)
Catch
End Try
If ExpSettingQuestion = vbYes Then
Call Make_DXF(doc,oAsmDoc, Rev_Level, Material_Path,oThickness,oMaterial)
Else If ExpSettingQuestion = vbNo Then
Call Make_DXF1(doc,oAsmDoc, Rev_Level, Material_Path,oThickness,oMaterial)
End If
Catch
End Try
InventorVb.DocumentUpdate()
iLogicVb.UpdateWhenDone = True
End If
End If
Next
MsgBox("DXF Export Complete",,"All Done")
End Sub
Sub Make_DXF(oDoc As Document,AsmDoc As Document, Rev_L As String, File_Location As String,oThickness As Double ,oMaterial As String)
'Get the ActiveLevelOfDetailRepresentation Name
doc = ThisDoc.Document
Dim oAssyDef As AssemblyComponentDefinition = doc.ComponentDefinition
Dim MyLOD_Name As String
MyLOD_Name = oAssyDef.RepresentationsManager.ActiveLevelOfDetailRepresentation.Name
If Not MyLOD_Name = "Master" Then
'activate master because only it can do the trick
Call oAssyDef.RepresentationsManager.LevelOfDetailRepresentations.Item(1).Activate
End If
Dim oBOM As BOM = AsmDoc.ComponentDefinition.BOM
oBOM.PartsOnlyViewEnabled = True
Dim oBOMView As BOMView = oBOM.BOMViews.Item("Parts Only")
For Each oBOMRow As BOMRow In oBOMView.BOMRows
Dim rDoc As Document = oBOMRow.ComponentDefinitions.Item(1).Document
If rDoc.DisplayName = oDoc.DisplayName Then
Dim oQty As Integer = oBOMRow.TotalQuantity
ThisApplication.Documents.Open(oDoc.FullFileName, False)
Dim Part_Name As String = oDoc.DisplayName.Replace(".ipt", "")
Dim a As String = oDoc.PropertySets.Item("Design Tracking Properties").Item("Stock Number").Value
Dim oFilename As String = File_Location & "\" & Part_Name & " - " & oMaterial & " " & oThickness & "mm - " & oQty & " off.dxf"
ThisApplication.SilentOperation = True
Dim oCompDef As SheetMetalComponentDefinition = oDoc.ComponentDefinition
If oCompDef.HasFlatPattern = False Then
oCompDef.Unfold
oCompDef.FlatPattern.ExitEdit
End If
Dim optionList As List(Of String) = New List(Of String)()
optionList.Add("AcadVersion=2004")
optionList.Add("OuterProfileLayer=0")
optionList.Add("InteriorProfilesLayer=0")
optionList.Add("UnconsumedSketchesLayer=YELLOW")
optionList.Add("UnconsumedSketchesLayerColor=255;255;0")
optionList.Add("BendUpLayer=YELLOW")
optionList.Add("BendUpLayerColor=255;255;0")
optionList.Add("BendDownLayer=YELLOW")
optionList.Add("BendDownLayerColor=255;255;0")
optionList.Add("MarkSurfaceUpLayer=YELLOW")
optionList.Add("MarkSurfaceUpLayerColor=255;255;0")
optionList.Add("MarkSurfaceDownLayer=YELLOW")
optionList.Add("MarkSurfaceDownColor=255;255;0")
Dim sOut As String
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"
For Each opt In optionList
sOut = sOut & "&" & opt
Next
sOut = sOut & "?OFILE"
oCompDef.DataIO.WriteDataToFile(sOut, oFilename)
oCompDef.FlatPattern.ExitEdit
oDoc.Close
Exit For
End If
Next
oAssyDef.RepresentationsManager.LevelOfDetailRepresentations.Item(MyLOD_Name).Activate
End Sub
Sub Make_DXF1(oDoc As Document,AsmDoc As Document, Rev_L As String, File_Location As String,oThickness As Double ,oMaterial As String)
doc = ThisDoc.Document
Dim oAssyDef As AssemblyComponentDefinition = doc.ComponentDefinition
Dim MyLOD_Name As String
MyLOD_Name = oAssyDef.RepresentationsManager.ActiveLevelOfDetailRepresentation.Name
If Not MyLOD_Name = "Master" Then
Call oAssyDef.RepresentationsManager.LevelOfDetailRepresentations.Item(1).Activate
End If
Dim oBOM As BOM = AsmDoc.ComponentDefinition.BOM
oBOM.PartsOnlyViewEnabled = True
Dim oBOMView As BOMView = oBOM.BOMViews.Item("Parts Only")
For Each oBOMRow As BOMRow In oBOMView.BOMRows
Dim rDoc As Document = oBOMRow.ComponentDefinitions.Item(1).Document
If rDoc.DisplayName = oDoc.DisplayName Then
Dim oQty As Integer = oBOMRow.TotalQuantity
ThisApplication.Documents.Open(oDoc.FullFileName, False)
Dim Part_Name As String = oDoc.DisplayName.Replace(".ipt", "")
Dim a As String = oDoc.PropertySets.Item("Design Tracking Properties").Item("Stock Number").Value
Dim oFilename As String = File_Location & "\" & Part_Name & " - " & oMaterial & " " & oThickness & "mm - " & oQty & " off.dxf"
ThisApplication.SilentOperation = True
Dim oCompDef As SheetMetalComponentDefinition = oDoc.ComponentDefinition
If oCompDef.HasFlatPattern = False Then
oCompDef.Unfold
oCompDef.FlatPattern.ExitEdit
End If
Dim optionList As List(Of String) = New List(Of String)()
optionList.Add("AcadVersion=2004")
optionList.Add("OuterProfileLayer=0")
optionList.Add("InteriorProfilesLayer=0")
optionList.Add("UnconsumedSketchesLayer=YELLOW")
optionList.Add("UnconsumedSketchesLayerColor=255;255;0")
optionList.Add("")
optionList.Add("")
Dim sOut As String
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"
For Each opt In optionList
sOut = sOut & "&" & opt
Next
sOut = sOut & "?OFILE"
oCompDef.DataIO.WriteDataToFile(sOut, oFilename)
oCompDef.FlatPattern.ExitEdit
oDoc.Close
Exit For
End If
Next
oAssyDef.RepresentationsManager.LevelOfDetailRepresentations.Item(MyLOD_Name).Activate
End Sub
Solved! Go to Solution.
Solved by lmc.engineering. Go to Solution.
Solved by lmc.engineering. Go to Solution.
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
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
Can't find what you're looking for? Ask the community or share your knowledge.