Solved: Sheet metal DXF (sorting and adding text)

Anonymous · ‎11-11-2020

Hello,

I "borrowed" some code I found on the Forum to make DXF files.

In an individual setting these codes work after some adjustments. But I can't get them to run combined as my knowledge with iLogic still has to improve.

What I want:

I want a to run the rule in the main assembly.

There it looks which parts are sheet metal
if sheet metal:
- Sort files in folders according to Material and Thickness (works)
- Create the DXF with some specific colors (works)
- Add some text in the middle of the DXF with: Part number, Quantity (is specified in our parts with Keywords), Material and Thickness. (doesn't work)

I believe it screws up with some referencing but I'm not sure

Any help would be highly appreciated!

This is the code which I combined (add it to an assembly with some sheet metal parts):

'https://forums.autodesk.com/t5/Inventor-customization/export-To-dxf-In-separate-folders-By-thickness/m-p/8891417

Sub Main()
    
    Dim New_Folder_Path As String = ThisDoc.Path
    Dim oAsmDoc As AssemblyDocument = ThisDoc.Document
 
    My.Computer.FileSystem.CreateDirectory(New_Folder_Path)
    
    'Ask user for REV level
    Dim Rev_Level As String = ""
    Rev_Level = InputBox ("Enter Rev Level","Creating DXF files For Entire Assembly")
    
    Dim Count_up As Integer = 0
    Dim Gauge_Folders(12) As String
    Dim Ga As String
    Dim doc As Document
	Dim R_Part As String
	Dim oMaterial As Material
    
	'=========================================================
	'TOEVOEGING!
	oPath = ThisDoc.Path

	FileNameNoExt = ThisDoc.FileName(False) 'without extension
	Dim Props As String = AddDXFProperties( True)
	Dim aryProps() As String = Split(Props,"\P")
	Dim PropVal(3) As String

	For i = 0 To UBound(aryProps)

		Dim PropSplitVal() As String = Split(aryProps(i),":")
		PropVal(i) = Trim(PropSplitVal(1))
		PropResults = PropResults & vbNewLine & aryProps(i)

	Next
	'EINDE TOEVOEGING
	'=========================================================
	
    For Each doc In oAsmDoc.AllReferencedDocuments 
        If doc.SubType = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Then 
			Try
				R_Part = doc.DisplayName
				oMaterial = doc.ComponentDefinition.Material
				Gauge_Path = New_Folder_Path & "\DXF\" & oMaterial.Name & " - " & Parameter(R_Part, "Thickness") &"mm"
							MessageBox.Show(Gauge_Path )
				Try
					My.Computer.FileSystem.CreateDirectory(Gauge_Path)						
				Catch
				End Try
            	Call Make_DXF(doc, Rev_Level, Gauge_Path)
				
				'TOEVOEGING!
				'===========
				'MsgBox("Oproepen AddDXFPropperties")
				Call AddDXFProperties()
				'MsgBox("Oproepen AddDXFPropperties gelukt")
				'===========       
			Catch
			End Try		
		End If
    Next 
MsgBox("DXF Export Complete",,"All Done")		
    
End Sub
    
Sub Make_DXF(oDoc As Document, Rev_L As String, File_Location As String)

	ThisApplication.Documents.Open(oDoc.FullFileName, True)
		
	Dim Part_Name As String = oDoc.DisplayName
	Dim TestPos As Integer = 0

	Dim Rev_Adder As String = ""
	If Rev_L <> "" Then Rev_Adder = " REV " & Rev_L

	TestPos = InStr(1, Part_Name, ".")

	If TestPos <> 0 Then Part_Name = Left(Part_Name, InStr(Part_Name, ".")-1)

	Dim New_Name As String = Part_Name 

	Dim oFilename As String  = File_Location & "\" & New_Name & Rev_Adder & ".dxf"

	Dim oCompDef As SheetMetalComponentDefinition = oDoc.ComponentDefinition

	If oCompDef.HasFlatPattern = False Then 
		oCompDef.Unfold
	Else
		oCompDef.FlatPattern.Edit
	End If
	
	'TOEVOEGING
	Dim sOut As String
	sOut = "FLAT PATTERN DXF?AcadVersion=2018" _
			+ "&InteriorProfileLayer=IV_INTERIOR_PROFILES" _
			+ "&InteriorProfilesLayerColor=255;255;0" _
			+ "&OuterProfileLayer=IV_EXTERIOR_PROFILES" _		
			+ "&InvisibleLayers=IV_TANGENT" _
			+ "&SimplifySplines=True" _
			+ "&BendLayerLineType=37634" _
			+ "&BendLayerColor=255;255;0" _
			+ "&BendUpLayerLineType=37634" _
			+ "&BendUpLayerColor=255;0;0" _
			+ "&BendDownLayerLineType=37634" _
			+ "&BendDownLayerColor=0;255;0" _
			+ "&FeatureProfilesLayerLineType=37634" _
			+ "&FeatureProfilesLayerColor=255;255;0" _
			+ "&FeatureProfilesUpLayerLineType=37634" _
			+ "&FeatureProfilesUpLayerColor=255;255;0" _
			+ "&FeatureProfilesDownLayerLineType=37634" _
			+ "&FeatureProfilesDownLayerColor=255;255;0"
	'EINDE TOEVOEGING

	Dim oFlatPattern As FlatPattern = oCompDef.FlatPattern
	Dim oFace As Face = oFlatPattern.TopFace

	Dim oCommand As CommandManager = ThisApplication.CommandManager

	oCommand.DoSelect(oFace)
	
	oCommand.PostPrivateEvent(PrivateEventTypeEnum.kFileNameEvent, oFilename) 
	
	oCompDef.DataIO.WriteDataToFile (sOut, oFilename)
	'========Oude Commando (Vervangen door regel hier boven ============
	'oCommand.ControlDefinitions.Item("GeomToDXFCommand").Execute2(True)

	oCompDef.FlatPattern.ExitEdit
	oDoc.Close

End Sub



'Haalt de gegevens op zoals PartNummer, Materiaal en Aantal
'Bepaald ook de plaatsing van deze gegevens in de DXF
'===========================================================
Public Function AddDXFProperties(Optional JustReturnText As Boolean = False) As String

'Generate the dxf properties to place in the dxf file as text.
'=============================================================
'MsgBox("Begin")
Dim PartNummer As String = "Part Nummer: " & UCase(ThisDoc.FileName(False)) 'false = without extension '(iProperties.Value("Project", "Part Number")) 'without extension

Dim Aantal As String = "Aantal: " & UCase(iProperties.Value("Summary", "Keywords"))

Dim Materiaal As String = "Materiaal: " & UCase(iProperties.Material)

Dim Dikte As String = "Dikte: " & UCase(Thickness)

Dim sText As String = PartNummer & "\P" & Aantal & "\P" & Materiaal & "\P" & Dikte

'Plaatsing tekst
'MsgBox("PlaatsenTEXT")
If JustReturnText = False Then

	extents_length = SheetMetal.FlatExtentsLength
	extents_width = SheetMetal.FlatExtentsWidth

	PosX = extents_length/2

	PosY = extents_width/-2

	'Part Nummer
	'MsgBox("Call EditDXFFile")
	Call EditDXFFile(PartNummer, PosX, PosY, FileName, "1D5")
	'MsgBox("Call EditDXFFile gelukt?")
	'Aantal
	Call EditDXFFile(Aantal, PosX, PosY - 5, FileName, "1D6")
	'Materiaal
	Call EditDXFFile(Materiaal, PosX, PosY - 10, FileName, "1D7")
	'Dikte
	Call EditDXFFile(Dikte, PosX, PosY - 15, FileName, "1D8")	

End If


AddDXFProperties = sText


End Function


'Voegt de tekst toe aan de DXF? Tekstgrote is hier te wijzigen
'Wordt opgeroepen door Public Function AddDXFProperties
'=============================================================
Public Sub EditDXFFile(TextToAdd As String, PosX As Double, PosY As Double, FileName As String, IDnumber As String) 

	'FileName has No pathway and No Extension

	'Add required text to edit the dxf file (3,55 is de tekstgrote om te wijzigen op het moment)


	Dim RequiredText As String =  "TEXT" _
		& vbNewLine & "  5" _
		& vbNewLine & IDnumber _
		& vbNewLine & "330" _
		& vbNewLine & "71" _
		& vbNewLine & "100" _
		& vbNewLine & "AcDbEntity" _
		& vbNewLine & "  8" _
		& vbNewLine & "0" _
		& vbNewLine & "100" _
		& vbNewLine & "AcDbText" _
		& vbNewLine & " 10" _
		& vbNewLine & PosX _
		& vbNewLine & " 20" _
		& vbNewLine & PosY _
		& vbNewLine & " 30" _
		& vbNewLine & "0.0" _
		& vbNewLine & " 40" _
		& vbNewLine & "3.55" _ 'Text Height
		& vbNewLine & "  1" _
		& vbNewLine

	Dim realTextToAdd As String = RequiredText & TextToAdd _
		& vbNewLine & "100" _
		& vbNewLine & "AcDbText" _
		& vbNewLine & "0" _
		& vbNewLine 

	Dim textLen As Integer = realTextToAdd.Length() 

	FileName = ThisDoc.FileName(False) 
	
	oPath = ThisDoc.Path 

	sFname = oPath & "\" & FileName & ".dxf" 
	
'MsgBox("5")	
	Dim readText As String = System.IO.File.ReadAllText(oFilename) 
'MsgBox("5.1")	
	Dim re As New System.Text.RegularExpressions.Regex("(?<=ENTITIES((?!ENDSEC).)*)ENDSEC", System.Text.RegularExpressions.RegexOptions.Singleline) 
'MsgBox("5.2")	
	Dim i As Integer = 0 

'MsgBox("6")	

	For Each match In re.Matches(readText) 

		readText = readText.Insert(match.Index + textLen * i, realTextToAdd) 

		i = i + 1 

	Next 

'MsgBox("7")	
	System.IO.File.WriteAllText(oFilename, readText) 
'MsgBox("8")
End Sub

And this is the code where I have the added text to work but only in a stand alone part:

'https://forums.autodesk.com/t5/inventor-customization/dxf-positioning/m-p/7599038

Sub Main

'Trigger = iTrigger0
'Exit Sub

'Get the pathway to the active document
'======================================
oPath = ThisDoc.Path

FileNameNoExt = ThisDoc.FileName(False) 'without extension



Dim Props As String = AddDXFProperties( True)



Dim aryProps() As String = Split(Props,"\P")

Dim PropVal(3) As String



For i = 0 To UBound(aryProps)

	Dim PropSplitVal() As String = Split(aryProps(i),":")

	PropVal(i) = Trim(PropSplitVal(1))

	PropResults = PropResults & vbNewLine & aryProps(i)

Next

'Vraagt of je de gegevens wil aanpassen (Dit wil ik niet dus daarom uit)
'=======================================================================

'Answer = MessageBox.Show(PropResults & vbNewLine & vbNewLine & "Would you like edit any of these flat patterns properties?", "Flat Pattern Properties",MessageBoxButtons.YesNo,MessageBoxIcon.Question)

'If Answer = vbYes Then

'	iProperties.Value("Project", "Part Number") = InputBox("Enter the Part Number.", "Part Number", PropVal(0))
'	If Trim(iProperties.Value("Project", "Part Number")) = "" Then Exit Sub
'	iProperties.Value("Summary", "Keywords") = InputBox("Enter the quantity.", "Quantity", PropVal(1))	
'	If Trim(iProperties.Value("Summary", "Keywords")) = ""  Then Exit Sub
'	iProperties.Material = InputBox("Enter the Material.", "Material", PropVal(2))	
'	If Trim(iProperties.Material) = "" Then Exit Sub
'	'SheetMetal.SetActiveStyle(Matl)
'	iProperties.Value("Project", "Stock Number") = InputBox("Enter the Designer.", "Stock Number", PropVal(3))	

'End If



Answer = MessageBox.Show("Would you like to create flat patterns for all parts in the active folder?", "Create Flat Patterns",MessageBoxButtons.YesNo,MessageBoxIcon.Question)



'set condition based on answer 

If Answer = vbYes Then

	'See if user wants the files saved upon closing

	SaveDoc = CBool(MessageBox.Show("Do you wish to have the files saved upon closing?", "Save Files?",MessageBoxButtons.YesNo,MessageBoxIcon.Question))



	'Create the DXF for the active document first

	'Call CreateDXF(oPath)



	invApp = GetObject(, "Inventor.Application")

	'Get all File names in the active document's directory

	Dim FileEntries As String() = System.IO.Directory.GetFiles(oPath)



	'Loop through all the files in the active document's directory

	For i = 0 To UBound(FileEntries)

		'MsgBox(FileEntries(i))

		

		'Make sure the file is a part file.

		Extension = System.IO.Path.GetExtension(FileEntries(i))

		FileName = System.IO.Path.GetFileNameWithoutExtension(FileEntries(i))

		'MsgBox(Extension)

		If Extension = ".ipt" Then

			'Open the current file in the loop 

			DwgToOpen = invApp.Documents

			'MsgBox ("Hello " & FileEntries(i))

			DwgToOpen.Open(FileEntries(i))

			ThisApplication.SilentOperation = True

			

			'See if the part is an iPart

			Dim oiPartDoc As PartDocument

    		oiPartDoc = invApp.ActiveDocument

			If oiPartDoc.ComponentDefinition.IsiPartFactory  Then

				

				'Create a flat pattern for each iPart Member

				Call LoopThruiParts(oPath)



			Else

				'Create Flat Pattern for the active document

				Call CreateDXF(oPath, FileName)

				Call AddDXFProperties()

				'Do not close the initial file

				If FileNameNoExt <> FileName Then

					Dim DocToClose As Inventor.Document

					DocToClose = invApp.ActiveDocument

					'MsgBox(SaveDoc)

					DocToClose.Close(Not SaveDoc)

				End If
		
			End If

		End If

	Next

ElseIf Answer = vbNo Then
	

'Create Flat Pattern for the active document
'===========================================

	'See if the part is an iPart
	'===========================
	Dim iPartDoc As PartDocument

	iPartDoc = ThisDoc.Document

	If iPartDoc.ComponentDefinition.IsiPartFactory  Then

		'Create a flat pattern for each iPart Member

		Call LoopThruiParts(oPath)

	Else

		Call CreateDXF(oPath, ThisDoc.FileName(False))

		Call AddDXFProperties()

	End If

End If

ThisApplication.SilentOperation = False


'iLogicVb.UpdateWhenDone = True

End Sub




Dim SaveDoc As Boolean

Dim ShowMsg As Boolean = True

Dim OverwriteFile As Boolean



'Maakt de DXF.
'Vraagt: Overschrijven, Maakt van Part een SheetMetal part, Unfold, Fold en set de DXF properties
'================================================================================================
Public Sub CreateDXF(oPath As String, sFname As String)

'MsgBox ("Hello CreateDXF")



'The file format will depend on the extension'Set file name extension to ".DXF"

'Create the full path and file name

sFname = oPath & "\" & sFname & ".dxf"

'MsgBox ("Hello Pathway")


'Check to see if the file exists
'===============================
If System.IO.File.Exists(sFname) Then

	If ShowMsg = True Then

		ThisApplication.SilentOperation = False

		OverwriteFile = CBool(MessageBox.Show("File " & sFname & " already exists." & vbNewLine & "Would you like to overwrite it ?" & vbNewLine & "This will not be asked again this session." , "Overwrite File",MessageBoxButtons.YesNo,MessageBoxIcon.Question))

	End If

	'set condition based on answer 

	If OverwriteFile = False Then Exit Sub

	ThisApplication.SilentOperation = True

End If


'Kijkt of het part geschikt is om een sheetmetal bestand van te maken.
'Kan volgens mij uit samen met de stukje 2 kopjes hier onder.
'======================================================================
'MsgBox("About to test for file type")

Dim objDoc As Document = ThisApplication.ActiveEditDocument

'Make sure the open document is suitable for sheet metal (Must be a part file)

If objDoc.DocumentType <> kPartDocumentObject Then

	ThisApplication.SilentOperation = False

	MessageBox.Show("A sheet metal part file must be active to generate the flat pattern.", "Invalid Part File!")

	Exit Sub

End If

'MsgBox("File type confirmed")





'get DXF target folder path
'==========================
oFolder = oPath

Dim oDoc As PartDocument

'MsgBox("About to Set to Sheet Metal")

oDoc = ThisApplication.ActiveDocument

Dim oCompDef As SheetMetalComponentDefinition



'Try setting the part file to sheet metal
'Kan volgens mij van standaard parts een sheetmetal part maken, de vraag is of dit gewenst is! Zo, niet uitschakelen!
'====================================================================================================================
Try

	oCompDef = oDoc.ComponentDefinition

Catch

	ThisApplication.SilentOperation = False	

	MessageBox.Show("A sheet metal part file must be active to generate the flat pattern.", "Invalid Part File!")

	Exit Sub

End Try

'MsgBox("Sheet Metal Confirmed")



'Unfold the part file if it is not already unfolded
'==================================================
If oCompDef.HasFlatPattern = False Then

'	MsgBox("ABout to unfold")
	oCompDef.Unfold
'	MsgBox("Unfolded")

Else

'	MsgBox("About to edit flat pattern")
	oCompDef.FlatPattern.Edit
'	MsgBox("Flat pattern confirmed")

End If



'Set properties of the output file. Version of AutoCAD, Bendlines to Cyan, Remove the tangent lines
'==================================================================================================
sOut =        "FLAT PATTERN DXF?AcadVersion=2018" _
			+ "&InteriorProfileLayer=IV_INTERIOR_PROFILES" _
			+ "&InteriorProfilesLayerColor=255;255;0" _
			+ "&OuterProfileLayer=IV_EXTERIOR_PROFILES" _		
			+ "&InvisibleLayers=IV_TANGENT" _
			+ "&SimplifySplines=True" _
			+ "&BendLayerLineType=37634" _
			+ "&BendLayerColor=255;255;0" _
			+ "&BendUpLayerLineType=37634" _
			+ "&BendUpLayerColor=255;0;0" _
			+ "&BendDownLayerLineType=37634" _
			+ "&BendDownLayerColor=0;255;0" _
			+ "&FeatureProfilesLayerLineType=37634" _
			+ "&FeatureProfilesLayerColor=255;255;0" _
			+ "&FeatureProfilesUpLayerLineType=37634" _
			+ "&FeatureProfilesUpLayerColor=255;255;0" _
			+ "&FeatureProfilesDownLayerLineType=37634" _
			+ "&FeatureProfilesDownLayerColor=255;255;0"


'Check for the DXF folder and create it if it does not exist
'===========================================================
If Not System.IO.Directory.Exists(oFolder) Then

	System.IO.Directory.CreateDirectory(oFolder)

End If



'put the flat pattern to a file
'==============================
'MsgBox("About to create dxf")
oCompDef.DataIO.WriteDataToFile (sOut, sFname)
'MsgBox("dxf created")



'Try switching back to the folded part
'=====================================
Try
    oCompDef.FlatPattern.ExitEdit
Catch
    'MsgBox("Error Exitting Flat Pattern!")
End Try
'MsgBox("switched to folded part")

End Sub





'Haalt de gegevens op zoals PartNummer, Materiaal en Aantal
'Bepaald ook de plaatsing van deze gegevens in de DXF
'===========================================================
Public Function AddDXFProperties(Optional JustReturnText As Boolean = False) As String

'Volgende 4 regels uitgeschakeld, de waardes worden verderop bepaald.
'=====================================================================

'Dim RevisionNo As String = ThisApplication.ActiveDocument.PropertySets.Item("Inventor Summary Information").Item("Revision Number").Value
'Dim Designer As String = ThisApplication.ActiveDocument.PropertySets.Item("Design Tracking Properties").Item("Designer").Value
'Dim sMaterial As String = SheetMetal.GetActiveStyle()
'Dim FileName As String = ThisDoc.FileName(False) 'without extension




'Generate the dxf properties to place in the dxf file as text.
'=============================================================
Dim PartNummer As String = "Part Nummer: " & UCase (ThisDoc.FileName(False)) 'false = without extension '(iProperties.Value("Project", "Part Number")) 'without extension

Dim Aantal As String = "Aantal: " & UCase(iProperties.Value("Summary", "Keywords"))

Dim Materiaal As String = "Materiaal: " & UCase(iProperties.Material)

Dim Dikte As String = "Dikte: " & UCase(Thickness)

Dim sText As String = PartNummer & "\P" & Aantal & "\P" & Materiaal & "\P" & Dikte



'Plaatsing tekst

If JustReturnText = False Then

	extents_length = SheetMetal.FlatExtentsLength
	extents_width = SheetMetal.FlatExtentsWidth

	

	PosX = extents_length/2

	PosY = extents_width/-2

	

	'Part Nummer
	Call EditDXFFile(PartNummer, PosX, PosY, FileName, "1D5")

	'Aantal
	Call EditDXFFile(Aantal, PosX, PosY - 5, FileName, "1D6")

	'Materiaal
	Call EditDXFFile(Materiaal, PosX, PosY - 10, FileName, "1D7")

	'Dikte
	Call EditDXFFile(Dikte, PosX, PosY - 15, FileName, "1D8")	

End If



AddDXFProperties = sText



End Function






'Voegt de tekst toe aan de DXF? Tekstgrote is hier te wijzigen
'Wordt opgeroepen door Public Function AddDXFProperties
'=============================================================
Public Sub EditDXFFile(TextToAdd As String, PosX As Double, PosY As Double, FileName As String, IDnumber As String) 

	'FileName has No pathway and No Extension

	

	'Add required text to edit the dxf file (3,55 is de tekstgrote om te wijzigen op het moment)

	Dim RequiredText As String = "TEXT" & vbNewLine & "  5" & vbNewLine & IDnumber & vbNewLine & "330" & vbNewLine & "71"  & vbNewLine & "100"  & vbNewLine & "AcDbEntity" & vbNewLine & "  8" & vbNewLine  & "0" & vbNewLine & "100" & vbNewLine & "AcDbText"  & vbNewLine & " 10" & vbNewLine & PosX  & vbNewLine & " 20"  & vbNewLine & PosY  & vbNewLine & " 30" & vbNewLine & "0.0" & vbNewLine &" 40" & vbNewLine & "3.55" & vbNewLine & "  1" & vbNewLine



	Dim realTextToAdd As String = RequiredText & TextToAdd & vbNewLine & "100" & vbNewLine & "AcDbText" & vbNewLine & "0" & vbNewLine 



	Dim textLen As Integer = realTextToAdd.Length() 

	FileName = ThisDoc.FileName(False) 

	oPath = ThisDoc.Path 



	sFname = oPath & "\" & FileName & ".dxf" 

	

	Dim readText As String = System.IO.File.ReadAllText(sFname) 

	Dim re As New System.Text.RegularExpressions.Regex("(?<=ENTITIES((?!ENDSEC).)*)ENDSEC", System.Text.RegularExpressions.RegexOptions.Singleline) 

	Dim i As Integer = 0 

	

	For Each match In re.Matches(readText) 

		readText = readText.Insert(match.Index + textLen * i, realTextToAdd) 

		i = i + 1 

	Next 

	

	System.IO.File.WriteAllText(sFname, readText) 

End Sub




'Plaatsing tekst en waardes ophalen iParts (zou in principe uitgeschakeld kunnen worden)
'=======================================================================================
Public Sub LoopThruiParts(oPath As String)

	'This sub iterates thru all of the Part of an iPart Factory

	'An iPart must be the active document



	Dim FileName As String

	'Set Connection to active document

	Dim oiPartDoc As PartDocument

	oiPartDoc = ThisDoc.Document

	'Check to see it it's an iPart

	If oiPartDoc.ComponentDefinition.IsiPartFactory  Then 		

		'Set a reference to the iPart Factory

		Dim oiPartFactory As iPartFactory

		oiPartFactory = oiPartDoc.ComponentDefinition.iPartFactory	

	

		'Loop through all the rows in the iPart table and set that row to the active iPart

		Dim i As Integer = 0

		For i = 1 To oiPartFactory.TableRows.Count

			

			Dim IPF As iPartFactory 

			IPF = oiPartDoc.ComponentDefinition.iPartFactory 



			Dim oRow As iPartTableRow 

			oRow = IPF.TableRows.Item(i)

			IPF.DefaultRow = oRow 

			FileName = iProperties.Value("Project", "Part Number")

			'Create Flat Pattern for the active document

			Call CreateDXF(oPath, FileName)

			

			'Generate the dxf properties to place in the dxf file

			Dim PartNummer As String = "Part Nummer: " & UCase (ThisDoc.FileName(False)) 'false = without extension

'			Dim RevNo As String

'			If Val(iProperties.Value("Project", "Revision Number")) <= 0 Then 

'				RevNo = "RV:1"

'			Else

'				RevNo = "RV:" & iProperties.Value("Project", "Revision Number")

'			End If

			Dim Materiaal As String = "Materiaal:" & iProperties.Material
			
			Dim Dikte As String = "Dikte: " & iProperties.Value("Summary", "Keywords")

			Dim Aantal As String = "Aantal: " & iProperties.Value("Summary", "Keywords")

			'Dim Routing As String = "ROUTING: " & RoutingNo

			

			Dim sText As String = PartNummer & "\P" & Aantal & "\P" & Materiaal & "\P" & Dikte

			

			extents_length = SheetMetal.FlatExtentsLength
			extents_width = SheetMetal.FlatExtentsWidth

			

			PosX = extents_length/2

			PosY = extents_width/-2

			

			'Call EditDXFFile(sText, PosX, PosY, FileName, IDnumber)

			'Part Nummer

			Call EditDXFFile(PartNummer, PosX, PosY, FileName, "1D5")

			'Aantal

			Call EditDXFFile(Aantal, PosX, PosY - 5, FileName, "1D6")

			'Materiaal

			Call EditDXFFile(Materiaal, PosX, PosY - 10, FileName, "1D7")

			'Dikte

			Call EditDXFFile(Dikte, PosX, PosY - 15, FileName, "1D8")				

		Next



	End If

End Sub

Anonymous · ‎11-12-2020

I've done some more searching and I think I have a clue where it goes wrong.

In the "Public Sub EditDXFFile" part of the code it needs to get the value "oFilename" from the "Sub Make_DXF" but it doesn't get that value apparently.

I have done a lot of searching on the forum on how to get that value but I still have no idea how I should get it to work.

So a small question to get me going again: How do you send a value from on Sub to another?

JhoelForshav · ‎11-12-2020

Hi @Anonymous

I've made some changes to your code. This works for me when I try it 🙂

Sub Main()

Dim New_Folder_Path As String = ThisDoc.Path
Dim oAsmDoc As AssemblyDocument = ThisDoc.Document
Dim Rev_Level As String = ""
Rev_Level = InputBox("Enter Rev Level", "Creating DXF files For Entire Assembly")
Dim doc As Document
Dim R_Part As String
Dim oMaterial As Material
Dim Gauge_Path As String

For Each doc In oAsmDoc.AllReferencedDocuments
	If doc.SubType = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Then
		Try
			R_Part = doc.DisplayName
			oMaterial = doc.ComponentDefinition.Material
			Gauge_Path = New_Folder_Path & "\DXF\" & oMaterial.Name & " - " & Parameter(R_Part, "Thickness") & "mm"
			'MessageBox.Show(Gauge_Path )
			Try
				My.Computer.FileSystem.CreateDirectory(Gauge_Path)
			Catch
			End Try
			Call Make_DXF(doc, Rev_Level, Gauge_Path)
		Catch
		End Try
	End If
Next
MsgBox("DXF Export Complete", , "All Done")

End Sub

Sub Make_DXF(oDoc As Document, Rev_L As String, File_Location As String)
	'ThisApplication.Documents.Open(oDoc.FullFileName)
	Dim Part_Name As String = oDoc.DisplayName
	Dim TestPos As Integer = 0

	Dim Rev_Adder As String = ""
	If Rev_L <> "" Then Rev_Adder = " REV " & Rev_L

	TestPos = InStr(1, Part_Name, ".")

	If TestPos <> 0 Then Part_Name = Left(Part_Name, InStr(Part_Name, ".") -1)

	Dim New_Name As String = Part_Name

	Dim oFilename As String = File_Location & "\" & New_Name & Rev_Adder & ".dxf"

	Dim oCompDef As SheetMetalComponentDefinition = oDoc.ComponentDefinition

	If oCompDef.HasFlatPattern = False Then
		oCompDef.Unfold
	Else
		oCompDef.FlatPattern.Edit
	End If

	Dim sOut As String
	sOut = "FLAT PATTERN DXF?AcadVersion=2018" _
	+ "&InteriorProfileLayer=IV_INTERIOR_PROFILES" _
	+ "&InteriorProfilesLayerColor=255;255;0" _
	+ "&OuterProfileLayer=IV_EXTERIOR_PROFILES" _
	+ "&InvisibleLayers=IV_TANGENT" _
	+ "&SimplifySplines=True" _
	+ "&BendLayerLineType=37634" _
	+ "&BendLayerColor=255;255;0" _
	+ "&BendUpLayerLineType=37634" _
	+ "&BendUpLayerColor=255;0;0" _
	+ "&BendDownLayerLineType=37634" _
	+ "&BendDownLayerColor=0;255;0" _
	+ "&FeatureProfilesLayerLineType=37634" _
	+ "&FeatureProfilesLayerColor=255;255;0" _
	+ "&FeatureProfilesUpLayerLineType=37634" _
	+ "&FeatureProfilesUpLayerColor=255;255;0" _
	+ "&FeatureProfilesDownLayerLineType=37634" _
	+ "&FeatureProfilesDownLayerColor=255;255;0"


	Dim oFlatPattern As FlatPattern = oCompDef.FlatPattern

	oCompDef.FlatPattern.ExitEdit
	oFlatPattern.DataIO.WriteDataToFile(sOut, oFilename)
	AddDXFProperties(oDoc, oFilename, False)
	oDoc.Close

End Sub
Public Function AddDXFProperties(oDoc As PartDocument, oDxfFile As String, Optional JustReturnText As Boolean = False) As String



	Dim PartNummer As String = "Part Nummer: " & UCase(oDoc.PropertySets("Design Tracking Properties")("Part Number").Value)

	Dim Aantal As String = "Aantal: " & UCase(oDoc.PropertySets("Inventor Summary Information")("Keywords").Value)

	Dim Materiaal As String = "Materiaal: " & UCase(oDoc.PropertySets("Design Tracking Properties")("Material").Value)

	Dim Dikte As String = "Dikte: " & UCase(oDoc.ComponentDefinition.Thickness.Expression)

	Dim sText As String = PartNummer & "\P" & Aantal & "\P" & Materiaal & "\P" & Dikte

	If JustReturnText = False Then
		Dim UoM As UnitsOfMeasure = oDoc.UnitsOfMeasure

		extents_length = UoM.ConvertUnits(oDoc.ComponentDefinition.FlatPattern.Length, UnitsTypeEnum.kDatabaseLengthUnits, UoM.LengthUnits)
		extents_width = UoM.ConvertUnits(oDoc.ComponentDefinition.FlatPattern.Width, UnitsTypeEnum.kDatabaseLengthUnits, UoM.LengthUnits)

		PosX = extents_length / 2

		PosY = extents_width / -2

		Call EditDXFFile(PartNummer, PosX, PosY, oDxfFile, "1D5")

		Call EditDXFFile(Aantal, PosX, PosY - 5, oDxfFile, "1D6")

		Call EditDXFFile(Materiaal, PosX, PosY - 10, oDxfFile, "1D7")

		Call EditDXFFile(Dikte, PosX, PosY - 15, oDxfFile, "1D8")

	End If


	AddDXFProperties = sText


End Function


Public Sub EditDXFFile(TextToAdd As String, PosX As Double, PosY As Double, FileName As String, IDnumber As String)

	Dim RequiredText As String = "TEXT" _
	& vbNewLine & "  5" _
	& vbNewLine & IDnumber _
	& vbNewLine & "330" _
	& vbNewLine & "71" _
	& vbNewLine & "100" _
	& vbNewLine & "AcDbEntity" _
	& vbNewLine & "  8" _
	& vbNewLine & "0" _
	& vbNewLine & "100" _
	& vbNewLine & "AcDbText" _
	& vbNewLine & " 10" _
	& vbNewLine & PosX _
	& vbNewLine & " 20" _
	& vbNewLine & PosY _
	& vbNewLine & " 30" _
	& vbNewLine & "0.0" _
	& vbNewLine & " 40" _
	& vbNewLine & "3.55" _	'Text Height
	& vbNewLine & "  1" _
	& vbNewLine

	Dim realTextToAdd As String = RequiredText & TextToAdd _
	& vbNewLine & "100" _
	& vbNewLine & "AcDbText" _
	& vbNewLine & "0" _
	& vbNewLine

	Dim textLen As Integer = realTextToAdd.Length()


	Dim readText As String = System.IO.File.ReadAllText(FileName)

	Dim re As New System.Text.RegularExpressions.Regex("(?<=ENTITIES((?!ENDSEC).)*)ENDSEC", System.Text.RegularExpressions.RegexOptions.Singleline)

	Dim i As Integer = 0



	For Each match In re.Matches(readText)

		readText = readText.Insert(match.Index + textLen * i, realTextToAdd)

		i = i + 1

	Next

	System.IO.File.WriteAllText(FileName, readText)

End Sub

Jhoel Forshav

Download my free Inventor Addin - Hole Projector

LinkedIn | Ideas | Contributions | Blog posts | Website

Anonymous · ‎11-13-2020

WOW thanks a lot @JhoelForshav !

I've tested it and everything seems to be working fine.

I only have to do some fine tuning with the positioning of the text within the DXF, sometimes it puts it just outside the part. But I think the has something to do with the face of the part.

I already put our codes next to each other to try and learn as much as possible but I need some more time to fully understand what is happening.

Again thank you very much!

JhoelForshav · ‎11-13-2020

I'm glad it works @Anonymous 🙂

It wouldn't hurt to clean the code up a bit but I just focused on getting it to work.

Jhoel Forshav

Download my free Inventor Addin - Hole Projector

LinkedIn | Ideas | Contributions | Blog posts | Website

Anonymous · ‎10-07-2021

@JhoelForshav Is there a way to set the text color or layer?

3DAli · ‎12-09-2021

Dim readText As String = System.IO.File.ReadAllText(sFname) 

	Dim re As New System.Text.RegularExpressions.Regex("(?<=ENTITIES((?!ENDSEC).)*)ENDSEC", System.Text.RegularExpressions.RegexOptions.Singleline) 

	Dim i As Integer = 0 

	

	For Each match In re.Matches(readText) 

		readText = readText.Insert(match.Index + textLen * i, realTextToAdd) 

		i = i + 1 

	Next

Hi Jhoel

can you help me to convert this part of the code to VBA? I have managed to change everything else to make it work in VBA except this part. I appreciate if you can help me with this.

Thanks

Ali

william · ‎03-22-2022

Perfect this is exactly what I need.
There are a lot of threads on this forum saying it is not possible to export dxf with text.
In my instance I am exporting named faces to dxf and the parts are a mix of sheet metal and standard parts, so I can't use the flat pattern export. This is a nice solution.

One question I had.. what is the below text formatting and where do I get info on this? Is all of this necessary?

	Dim RequiredText As String = "TEXT" _
	& vbNewLine & "  5" _
	& vbNewLine & IDnumber _
	& vbNewLine & "330" _
	& vbNewLine & "71" _
	& vbNewLine & "100" _
	& vbNewLine & "AcDbEntity" _
	& vbNewLine & "  8" _
	& vbNewLine & "0" _
	& vbNewLine & "100" _
	& vbNewLine & "AcDbText" _
	& vbNewLine & " 10" _
	& vbNewLine & PosX _
	& vbNewLine & " 20" _
	& vbNewLine & PosY _
	& vbNewLine & " 30" _
	& vbNewLine & "0.0" _
	& vbNewLine & " 40" _
	& vbNewLine & "3.55" _	'Text Height
	& vbNewLine & "  1" _
	& vbNewLine

	Dim realTextToAdd As String = RequiredText & TextToAdd _
	& vbNewLine & "100" _
	& vbNewLine & "AcDbText" _
	& vbNewLine & "0" _
	& vbNewLine

Second question is the line

Dim re As New System.Text.RegularExpressions.Regex("(?<=ENTITIES((?!ENDSEC).)*)ENDSEC", System.Text.RegularExpressions.RegexOptions.Singleline)

Just curious where these values came from.

Many thanks

Ralf_Krieg · ‎03-23-2022

Hello

The statement that it is not possible to export text with dxf is correct. The code adds the text afterwards by writing direct in the exported dxf file.

The required text comes from the dxf reference definition of a text entity. You can view the reference online for instance here: https://documentation.help/AutoCAD-DXF/

Check the Chapter TEXT in ENTITIES.

The RegEx, if I understand it right, searches for the first string "ENDDESC" after the string "ENTITIES" and returns the position right before the "ENDDESC" string. At that position the RealTextToAdd value is inserted. I'm not sure why running in a loop, cause dxf should have only one ENTITIES section, so there could only be one match. *???*

R. Krieg
RKW Solutions GmbH
www.rkw-solutions.com

william · ‎04-03-2022

Thanks. @Ralf_Krieg
I had the same issue as @Anonymous with the positioning of the text within the dxf, particularly exporting faces not aligned to the UCS.
What I found to work was reading through the dxf file afterwards, adding the vector points to an array, and calculating text positioning off of that.

Sub Main
dxfFilename = "your file.dxf"

SearchTerm = "AcDb2dVertex"
Dim ReadFile() As String = System.IO.File.ReadAllLines(dxfFilename)
Dim Array_X As New ArrayList
Dim Array_Y As New ArrayList

i = 0
For Each Line As String In System.IO.File.ReadAllLines(dxfFilename)
        If Line.Contains(SearchTerm) Then
        'MessageBox.Show("Line no. " & ReadFile(i), "Title")
		'MessageBox.Show("X = " & ReadFile(i + 2) & vbNewLine & "Y = " & ReadFile(i + 4), "Title")
		Array_X.Add(CInt(ReadFile(i + 2)))
		Array_Y.Add(CInt(ReadFile(i + 4)))
    End If
	i = i + 1
Next

Array_X.Sort()
Array_Y.Sort()

minX = Array_X(0)
maxX = Array_X(Array_X.Count-1)
minY = Array_Y(0)
maxY = Array_Y(Array_X.Count - 1)

PosX = ((maxX - minX) / 2) + minX
PosY = ((maxY - minY) / 2) + minY

'MessageBox.Show("minX = " & minX & vbNewLine & "maxX = " & maxX & vbNewLine & "minY = " & minY & vbNewLine & "maxY = " & maxY, "Title")

''Error Checking code - to see what the array values are
'oWrite = System.IO.File.CreateText(ThisDoc.PathAndFileName(False) & ".txt")
'For i = 0 To Array_X.Count - 1
'	oWrite.WriteLine("Array_X(" & i & ") = " & Array_X(i))
'Next
'For i = 0 To Array_Y.Count - 1
'	oWrite.WriteLine("Array_Y(" & i & ") = " & Array_Y(i))
'Next
'oWrite.Close()
'ThisDoc.Launch(ThisDoc.PathAndFileName(False) & ".txt")

Call EditDXFFile("Text Line 1", PosX, PosY, dxfFilename, "1D5")
Call EditDXFFile("Text Line 2", PosX, PosY - 5, dxfFilename, "1D6")
End Sub


Sub EditDXFFile(TextToAdd As String, PosX As Double, PosY As Double, dxfFilename As String, IDnumber As String)
	Dim RequiredText As String = "TEXT" _
	& vbNewLine & "  5" _
	& vbNewLine & IDnumber _
	& vbNewLine & "330" _
	& vbNewLine & "71" _
	& vbNewLine & "100" _
	& vbNewLine & "AcDbEntity" _
	& vbNewLine & "  8" _
	& vbNewLine & "0" _
	& vbNewLine & "100" _
	& vbNewLine & "AcDbText" _
	& vbNewLine & " 10" _
	& vbNewLine & PosX _
	& vbNewLine & " 20" _
	& vbNewLine & PosY _
	& vbNewLine & " 30" _
	& vbNewLine & "0.0" _
	& vbNewLine & " 40" _
	& vbNewLine & "3.55" _	'Text Height
	& vbNewLine & "  1" _
	& vbNewLine

	Dim realTextToAdd As String = RequiredText & TextToAdd _
	& vbNewLine & "100" _
	& vbNewLine & "AcDbText" _
	& vbNewLine & "0" _
	& vbNewLine

	Dim textLen As Integer = realTextToAdd.Length()
	Dim readText As String = System.IO.File.ReadAllText(dxfFilename)
	Dim re As New System.Text.RegularExpressions.Regex("(?<=ENTITIES((?!ENDSEC).)*)ENDSEC", System.Text.RegularExpressions.RegexOptions.Singleline)
	Dim i As Integer = 0

	For Each match In re.Matches(readText)
		readText = readText.Insert(match.Index + textLen * m, realTextToAdd)
		m = m + 1
	Next

	System.IO.File.WriteAllText(dxfFilename, readText)
End Sub

jaimin.ja.3 · ‎04-05-2022

Hey, @JhoelForshav thank you for sharing this code it works perfectly.
please find attached photos,
1. Notch at bend and marking lines = is it possible to add notch at both end of the marking line so that bender can easily match notch with die & need to reduce the size of bend line so we can reduce time of laser cutting and marking. ( 2nd option is add notch at only down bend line or optional)
2. file rename - if qty is mentioned in file name? (most of nesting software can read the file name formats & file saving structure, now if quantity is mentioned in file name then we don't need to add manually and it will gives precise cutting file qty and reduce time.

Maxim-CADman77 · ‎07-26-2023

Even so the thread is not new... I believe it worth to continue discussing note position control

Dear @william
The code you've shared doesn't work for me (and the post have no single "like").
Moreover none of DXFs exported from Inventor by means of the rule from solution-post contains "AcDb2dVertex" (there is even neither "AcDb2" nor "Vertex") ...
Most often "AcDb"-starting text-lines are "AcDbEntity" and "AcDbLine"...

... studying Autodesk Inventor since 2005 ...

william · ‎07-30-2023

Hello Maxim
You can find out more about the AcDb2dVertex class here.
AutoCAD 2023 for Mac Developer and ObjectARX Help | AcDb2dVertex | Autodesk
I did a quick test, exporting a face to dxf from inventor of a simple cube part, and a sheet metal flat pattern.
It seems as though the flat pattern doesn't use the AcDb2dVertex but rather AcDbLine instead. The export dxf for a selected face however does contain the AcDb2dVertex.

In my case, I am exporting named faces or surface bodies not flat patterns, so it works for me, but it seems as though there are some differences with the different commands.

Dim oCtrlDef As ButtonDefinition
Set oCtrlDef = ThisApplication.CommandManager.ControlDefinitions.Item("GeomToDXFCommand")
oCtrlDef.Execute

Dim oFlatPattern As FlatPattern = oCompDef.FlatPattern
oCompDef.FlatPattern.ExitEdit
oFlatPattern.DataIO.WriteDataToFile(sOut, oFilename)

You would have to modify the code to make this work for a sheet metal flat pattern.

Maxim-CADman77 · ‎07-14-2024

Dear @JhoelForshav

Don't you know how to set some custom color of the text added in the way you've shared (either change color of the 0 layer or add the text to some custom layer with custom color)?

Thank you in advance.

... studying Autodesk Inventor since 2005 ...

Sheet metal DXF (sorting and adding text)

Sheet metal DXF (sorting and adding text)

Forums Links

Post to forums