Exporting flat patterns from assembly to multiple DFX files

Exporting flat patterns from assembly to multiple DFX files

roman.heinrich
Explorer Explorer
1,083 Views
6 Replies
Message 1 of 7

Exporting flat patterns from assembly to multiple DFX files

roman.heinrich
Explorer
Explorer

Hello,
I am new to iLogic and I am trying to modify a code from this site:
iLogic: Export All Flat Patterns To One DXF – Clint Brown

I would like the code to export the DXFs to separate files for each SM component with the same name and still use the INI file to do so (for example A part.ipt would be A part.dxf). The files should be exported to the assembly folder.

I tried to add the drawing document part to the Loop so the invisible Drawing file is created for each component. I also removed the CreateTXT Sub and the transition of the views (since there should only be one Flat Pattern on the drawing anyways).
The modified code exports only one SM part and returns Error (Unspecified Error and Catch from line 135) for rest of them.

Note: I specified the INI file location in the code I was modifying.

I would appreciate if somebody could help me modify this code. 

Sub Main
	'modified code
	'former iLogic Code by Jhoel Forshav - originally posted at https://clintbrown.co.uk/ilogic-export-all-flat-patterns-to-one-dxf
	'Check that the active document is an assembly file
	If ThisApplication.ActiveDocument.DocumentType <> kAssemblyDocumentObject Then
		MessageBox.Show("This rule can only run from an Assembly file", "DXF-creator", MessageBoxButtons.OK, MessageBoxIcon.Error)
		Exit Sub
	End If
	'Dim the active document as AssemblyDocument
	Dim oDoc As AssemblyDocument = ThisApplication.ActiveDocument
	'Make sure the assembly is saved
	If oDoc.FullFileName = ""
		MessageBox.Show("Please save the Assembly before running this rule.", "DXF-creator", MessageBoxButtons.OK, MessageBoxIcon.Information)
		Exit Sub
	End If
	'Get the assembly filename without extension
	Dim oAsmName As String = System.IO.Path.GetFileNameWithoutExtension(oDoc.FullFileName)
	'Get the assembly filepath
	Dim oPath As String = System.IO.Path.GetDirectoryName(oDoc.FullFileName)

	'Get the parts only BOM.
	Dim oBOM As BOM = oDoc.ComponentDefinition.BOM
	'Make sure Parts Only is activated
	oBOM.PartsOnlyViewEnabled = True
	'Parts only will be last BomView (difficult to get by name since it's different depending on your language)
	Dim oBOMview As BOMView = oBOM.BOMViews.Item(oBOM.BOMViews.Count)

	'Set a reference to the TransientGeometry object
	Dim oTG As TransientGeometry = ThisApplication.TransientGeometry
	'oX and oY will be used to create points for view placement
	Dim oX As Double = 0
	Dim oY As Double = 0
	'Create the Baseview options to place flatpattern-views
	Dim oBaseViewOptions As NameValueMap
	oBaseViewOptions = ThisApplication.TransientObjects.CreateNameValueMap
	oBaseViewOptions.Add("SheetMetalFoldedModel", False)
	'Set a variable for the drawing document
	Dim oDrawing As DrawingDocument
	'Create a String to return a message if any SM-parts are not saved
	Dim unsavedSmParts As String = ""

	Dim oInfo As String = ""
	Dim pFileName As String

	'Traverse Parts Only BOM
	For Each oRow As BOMRow In oBOMview.BOMRows
		Dim oDef As ComponentDefinition = oRow.ComponentDefinitions(1)
		Dim oPartDoc As PartDocument = oDef.Document
		Try
			'Get the component definition for the part
			'Check if the part is SheetMetal
			If TypeOf (oDef) Is SheetMetalComponentDefinition
					pFileName = System.IO.Path.GetFileNameWithoutExtension(oPartDoc.FullFileName) 		
				'Set a reference to the partdocument
				Dim smPartDoc As PartDocument = oDef.Document
				'Check if the part is saved
				If smPartDoc.FullFileName = "" Then
					If unsavedSmParts = "" Then unsavedSmParts = "The fallowing SM-documents were not saved and therefore " & _
					"no drawingviews were created:" & vbCrLf
					unsavedSmParts = unsavedSmParts & vbCrLf & oDef.Document.DisplayName
					Continue For
				End If
				'Create flatpattern if it doesn't already exist
				If Not oDef.HasFlatPattern
					oDef.Unfold()
					oDef.FlatPattern.ExitEdit()
				End If
				'Create the drawing if it doesn't already exist
				If oDrawing Is Nothing
					oDrawing = ThisApplication.Documents.Add(DocumentTypeEnum.kDrawingDocumentObject, _
					, False)
					'Set the drawings length units to the same as the assemblys length units
					oDrawing.UnitsOfMeasure.LengthUnits = oDoc.UnitsOfMeasure.LengthUnits
				End If

				'Set a reference to the drawing sheet
				Dim oSheet As Sheet = oDrawing.ActiveSheet

				'Create the flatpattern view
				Dim oView As DrawingView = oSheet.DrawingViews.AddBaseView(smPartDoc, oTG.CreatePoint2d(oX, oY), 1 _
				, ViewOrientationTypeEnum.kDefaultViewOrientation, DrawingViewStyleEnum.kHiddenLineRemovedDrawingViewStyle, _
				"FlatPattern", , oBaseViewOptions)

				oView.Name = smPartDoc.DisplayName
				oView.ShowLabel = False
				RemoveBendLines(oView, oDef.FlatPattern)'You could comment out this line to keep bend lines
				smPartDoc.Close(True)
			End If
		Catch Ex As Exception
			MsgBox(Ex.Message)
		End Try
		'Create the save location string for the DXF
		Dim oDXFName As String = oPath & "\" & pFileName & ".dxf"
		'Save the DXF
		oINI = "" 'Specify your INI file location here (eg C:\TEMP\DXF Export.ini)
		If oINI = "" Then
			MessageBox.Show("You need to specify an INI file location in the code - Look for oINI and set the path", "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
		End If
		'only save SM parts
		If oDef.HasFlatPattern = True Then
			SaveDXF(oDrawing, oDXFName, oINI)
		End If
	'Close the drawing
	oDrawing.Close
	Next
	'return information about any unsaved parts
	If unsavedSmParts <> "" Then _
	MessageBox.Show(unsavedSmParts, "Some parts were not saved", _
	MessageBoxButtons.OK, MessageBoxIcon.Information)
	'Update the assembly (could be dirty if any flatpatterns were created)	
	oDoc.Update
End Sub

Sub SaveDXF(oDrawing As DrawingDocument, oFileName As String, oIniFile As String)
	'Set a reference to the DFX translator
	Dim DXFAddIn As TranslatorAddIn
	DXFAddIn = ThisApplication.ApplicationAddIns.ItemById("{C24E3AC4-122E-11D5-8E91-0010B541CD80}")
	'Create translation context
	Dim oContext As TranslationContext = ThisApplication.TransientObjects.CreateTranslationContext
	oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism
	'Create options for the translation
	Dim oOptions As NameValueMap = ThisApplication.TransientObjects.CreateNameValueMap
	'Create a DataMedium object
	Dim oDataMedium As DataMedium = ThisApplication.TransientObjects.CreateDataMedium
	'Set the options (which .ini-file to use)
	If DXFAddIn.HasSaveCopyAsOptions(oDrawing, oContext, oOptions) Then
		oOptions.Value("Export_Acad_IniFile") = oIniFile
	End If
	'Set the filename property of the DataMedium object
	oDataMedium.FileName = oFileName
	Try
		'Try to save the DXF
		DXFAddIn.SaveCopyAs(oDrawing, oContext, oOptions, oDataMedium)
		MessageBox.Show("Dxf saved to: " & oFileName, "DXF SAVED", MessageBoxButtons.OK, MessageBoxIcon.Information)
	Catch
		MessageBox.Show("Couldn't save dxf! " & oFileName, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
	End Try
End Sub

Sub RemoveBendLines(oView As DrawingView, oFlattPattern As FlatPattern)
	'Get all the bend edges from the FlatPattern
	Dim oBendEdgesUp As Edges = oFlattPattern.GetEdgesOfType(FlatPatternEdgeTypeEnum.kBendUpFlatPatternEdge)
	Dim oBendEdgesDown As Edges = oFlattPattern.GetEdgesOfType(FlatPatternEdgeTypeEnum.kBendDownFlatPatternEdge)

	For Each oEdge As Edge In oBendEdgesUp
		'Get the curves representing these edges in the drawing view
		For Each oCurve As DrawingCurve In oView.DrawingCurves(oEdge)
			For Each oSegment As DrawingCurveSegment In oCurve.Segments
				'Set visibility to false
				oSegment.Visible = False
			Next
		Next
	Next
	For Each oEdge As Edge In oBendEdgesDown
		For Each oCurve As DrawingCurve In oView.DrawingCurves(oEdge)
			For Each oSegment As DrawingCurveSegment In oCurve.Segments
				oSegment.Visible = False
			Next
		Next
	Next
End Sub



0 Likes
Accepted solutions (1)
1,084 Views
6 Replies
Replies (6)
Message 2 of 7

JelteDeJong
Mentor
Mentor

Does this work for you?

Sub Main()
	Dim doc As AssemblyDocument = ThisDoc.Document

    For Each refDoc As Document In doc.AllReferencedDocuments
        If (refDoc.SubType <> "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}") Then Continue For

        Dim newFileName As String = createFileName(refDoc)
        export(refDoc, newFileName)
    Next

End Sub

Public Sub export(doc As PartDocument, newFileName As String)
    Dim oCompDef As SheetMetalComponentDefinition = doc.ComponentDefinition
    If oCompDef.HasFlatPattern = False Then
        oCompDef.Unfold()
    Else
        oCompDef.FlatPattern.Edit()
    End If

    Dim sOut As String = "FLAT PATTERN DXF?AcadVersion=2000&OuterProfileLayer=IV_INTERIOR_PROFILES"
    oCompDef.DataIO.WriteDataToFile(sOut, newFileName)
    oCompDef.FlatPattern.ExitEdit()
End Sub

Function createFileName(doc As PartDocument) As String
    Dim dirName As String = IO.Path.GetDirectoryName(doc.FullFileName)
    Dim fileNameWithoutExtension As String = IO.Path.GetFileNameWithoutExtension(doc.FullFileName)

    Return String.Format("{0}\{1}.dxf",
        dirName, fileNameWithoutExtension)
End Function

Jelte de Jong
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.

EESignature


Blog: hjalte.nl - github.com

0 Likes
Message 3 of 7

JelteDeJong
Mentor
Mentor

Does this work for you?

 

Sub Main()
	Dim doc As AssemblyDocument = ThisDoc.Document

    For Each refDoc As Document In doc.AllReferencedDocuments
        If (refDoc.SubType <> "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}") Then Continue For

        Dim newFileName As String = createFileName(refDoc)
        export(refDoc, newFileName)
    Next

End Sub

Public Sub export(doc As PartDocument, newFileName As String)
    Dim oCompDef As SheetMetalComponentDefinition = doc.ComponentDefinition
    If oCompDef.HasFlatPattern = False Then
        oCompDef.Unfold()
    Else
        oCompDef.FlatPattern.Edit()
    End If

    Dim sOut As String = "FLAT PATTERN DXF?AcadVersion=2000&OuterProfileLayer=IV_INTERIOR_PROFILES"
    oCompDef.DataIO.WriteDataToFile(sOut, newFileName)
    oCompDef.FlatPattern.ExitEdit()
End Sub

Function createFileName(doc As PartDocument) As String
    Dim dirName As String = IO.Path.GetDirectoryName(doc.FullFileName)
    Dim fileNameWithoutExtension As String = IO.Path.GetFileNameWithoutExtension(doc.FullFileName)

    Return String.Format("{0}\{1}.dxf",
        dirName, fileNameWithoutExtension)
End Function

 

Jelte de Jong
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.

EESignature


Blog: hjalte.nl - github.com

0 Likes
Message 4 of 7

roman.heinrich
Explorer
Explorer

@JelteDeJong 
It does, but it doesn't use the INI (configuration file) so it has all the bend lines and all lines are same colour. Is there a way to incorporate it into the code (the code I was trying to modify uses it).

0 Likes
Message 5 of 7

SevInventor
Advocate
Advocate
Accepted solution

Hello Roman,

try this:

 

Sub Main
	'iLogic Code by Jhoel Forshav - originally posted at https://clintbrown.co.uk/ilogic-export-all-flat-patterns-to-one-dxf
	'Check that the active document is an assembly file
	If ThisApplication.ActiveDocument.DocumentType <> kAssemblyDocumentObject Then
		MessageBox.Show("This rule can only run from an Assembly file", "DXF-creator", MessageBoxButtons.OK, MessageBoxIcon.Error)
		Exit Sub
	End If
	'Dim the active document as AssemblyDocument
	Dim oDoc As AssemblyDocument = ThisApplication.ActiveDocument
	'Make sure the assembly is saved
	If oDoc.FullFileName = ""
		MessageBox.Show("Please save the Assembly before running this rule.", "DXF-creator", MessageBoxButtons.OK, MessageBoxIcon.Information)
		Exit Sub
	End If
	'Get the assembly filename without extension
	Dim oAsmName As String = System.IO.Path.GetFileNameWithoutExtension(oDoc.FullFileName)
	'Get the assembly filepath
	Dim oPath As String = System.IO.Path.GetDirectoryName(oDoc.FullFileName)

	'Get the parts only BOM.
	Dim oBOM As BOM = oDoc.ComponentDefinition.BOM
	'Make sure Parts Only is activated
	oBOM.PartsOnlyViewEnabled = True
	'Parts only will be last BomView (difficult to get by name since it's different depending on your language)
	Dim oBOMview As BOMView = oBOM.BOMViews.Item(oBOM.BOMViews.Count)


	'Set a reference to the TransientGeometry object
	Dim oTG As TransientGeometry = ThisApplication.TransientGeometry
	'oX and oY will be used to create points for view placement
	Dim oX As Double = 0
	Dim oY As Double = 0
	'Create the Baseview options to place flatpattern-views
	Dim oBaseViewOptions As NameValueMap
	oBaseViewOptions = ThisApplication.TransientObjects.CreateNameValueMap
	oBaseViewOptions.Add("SheetMetalFoldedModel", False)
	'Set a variable for the drawing document
	Dim oDrawing As DrawingDocument
	'Create a String to return a message if any SM-parts are not saved
	Dim unsavedSmParts As String = ""

	Dim i As Integer = 1
	Dim oInfo As String = ""

	'Traverse Parts Only BOM
	For Each oRow As BOMRow In oBOMview.BOMRows
		
'		Try
			'Get the component definition for the part
			Dim oDef As ComponentDefinition = oRow.ComponentDefinitions(1)
			Dim oDocu As Document = oDef.Document
			Dim oCompName As String = System.IO.Path.GetFileNameWithoutExtension(oDocu.FullFileName)
			Dim oDXFName As String = oPath & "\" & oCompName & ".dxf"
'			MsgBox(oDXFName)

				'Set a reference to the partdocument
				Dim smPartDoc As PartDocument = oDef.Document
				'Check if the part is saved
				If smPartDoc.FullFileName = "" Then
					If unsavedSmParts = "" Then unsavedSmParts = "The fallowing SM-documents were not saved and therefore " & _
					"no drawingviews were created:" & vbCrLf
					unsavedSmParts = unsavedSmParts & vbCrLf & oDef.Document.DisplayName
					Continue For
				End If
				'Create flatpattern if it doesn't already exist
				If Not oDef.HasFlatPattern
					Try 
					oDef.Unfold()
					oDef.FlatPattern.ExitEdit()
					Catch
						End Try
				End If
				'Create the drawing if it doesn't already exist
				If oDrawing Is Nothing
					oDrawing = ThisApplication.Documents.Add(DocumentTypeEnum.kDrawingDocumentObject, , False)
					'Set the drawings length units to the same as the assemblys length units
					oDrawing.UnitsOfMeasure.LengthUnits = oDoc.UnitsOfMeasure.LengthUnits
				End If

				'Set a reference to the drawing sheet
				Dim oSheet As Sheet = oDrawing.ActiveSheet


				'Create the flatpattern view
'				Try
				Dim oView As DrawingView = oSheet.DrawingViews.AddBaseView(smPartDoc, oTG.CreatePoint2d(0, 0), 1 , ViewOrientationTypeEnum.kDefaultViewOrientation, DrawingViewStyleEnum.kHiddenLineRemovedDrawingViewStyle, "FlatPattern", , oBaseViewOptions)
'				Catch
'				Dim oView As DrawingView = oSheet.DrawingViews.AddBaseView(smPartDoc, oTG.CreatePoint2d(0, 0), 1 , ViewOrientationTypeEnum.kDefaultViewOrientation, DrawingViewStyleEnum.kHiddenLineRemovedDrawingViewStyle, "FlatPattern", , oBaseViewOptions)
'				End Try
				oView.Name = smPartDoc.DisplayName
				oView.ShowLabel = True



				oInfo = oInfo & If (i = 1, "", vbCrLf) & i & ". " & smPartDoc.PropertySets.Item("Design Tracking Properties"). _
				Item("Part Number").Value

				i += 1

				'Close the part
				smPartDoc.Close(True)


		'Save the DXF
		oINI = "X:\DXF importieren.ini" 'Specify your INI file location here (eg C:\TEMP\DXF Export.ini)
		If oINI = "" Then
			MessageBox.Show("You need to specify an INI file location in the code - Look for oINI and set the path", "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)

	End If
	'Close the drawing
	SaveDXF(oDrawing, oDXFName, oINI)
	oView.Delete

	Next
End Sub

Sub SaveDXF(oDrawing As DrawingDocument, oFileName As String, oIniFile As String)
	'Set a reference to the DFX translator
	Dim DXFAddIn As TranslatorAddIn
	DXFAddIn = ThisApplication.ApplicationAddIns.ItemById("{C24E3AC4-122E-11D5-8E91-0010B541CD80}")
	'Create translation context
	Dim oContext As TranslationContext = ThisApplication.TransientObjects.CreateTranslationContext
	oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism
	'Create options for the translation
	Dim oOptions As NameValueMap = ThisApplication.TransientObjects.CreateNameValueMap
	'Create a DataMedium object
	Dim oDataMedium As DataMedium = ThisApplication.TransientObjects.CreateDataMedium
	'Set the options (which .ini-file to use)
	If DXFAddIn.HasSaveCopyAsOptions(oDrawing, oContext, oOptions) Then
		oOptions.Value("Export_Acad_IniFile") = oIniFile
	End If
	'Set the filename property of the DataMedium object
	oDataMedium.FileName = oFileName
	Try
		'Try to save the DXF
		DXFAddIn.SaveCopyAs(oDrawing, oContext, oOptions, oDataMedium)
		MessageBox.Show("Dxf saved to: " & oFilename, "DXF SAVED", MessageBoxButtons.OK, MessageBoxIcon.Information)
	Catch
		MessageBox.Show("Couldn't save dxf!"& oFilename, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
	End Try
	
End Sub


 

 

0 Likes
Message 6 of 7

roman.heinrich
Explorer
Explorer

It's working, DXFs with flat patterns are generated. there is an Error on line 66 but I can live with that 😄.
Thank you.

Message 7 of 7

Apollo_Tamworth
Contributor
Contributor

Are the layers set as you expect? 
The same name and same colour as defined in your "INI" file?

 

0 Likes