DXF CREATION WITH PART NUMBER ENGRAVED

[jerinc101]

Hi All,

I need to create ilogic for dxf creation with engraved part number of part and assembly. I have modified an ilogic from other thread. but its not working. can you please modify anyone. Thanks in advance.

Sub Main()
	
  	Dim myDate As String = Now().ToString("yyyy-MM-dd HH:mm:ss")	
	myDate = myDate.Replace(":", ".")  

	'change this as needed
	oRoot = ThisDoc.Path
	'oRoot = ThisDoc.Path 'use the document's containing folder path

	'change this as needed
	oSuffix = "DXF" 
	'oSuffix = iProperties.Value("Project", "Project") 'use the document's Project#
	'oSuffix = iProperties.Value("Project", "Part Number") 'use the document's Part#
	
	'get target folder path
	oFolder = oRoot & "\" & oSuffix & " (" & myDate & ")"
	
	'Check for the PDF folder and create it if it does not exist
	If Not System.IO.Directory.Exists(oFolder) Then
		System.IO.Directory.CreateDirectory(oFolder)
	End If
	
	'open the folder
	Process.Start(oFolder) 
	
	Dim oDoc As Document
	oDoc = ThisApplication.ActiveDocument	
	
	'PDF of the file you're running it this from

	
	'Loop through all referenced documents
	j= 1
	For Each oDoc In ThisApplication.ActiveDocument.AllReferencedDocuments	
		oName = oDoc.DisplayName
		ck = j Mod 2 
		If ck = 0 Then 
			oFlicker = ".......... "
		Else
			oFlicker = ".... "	
		End If
		ThisApplication.StatusBarText = "Processing DXF" & oFlicker & oName
		j = j + 1 

		'created DXF's of sheetmetal parts
		Call DXF_Out(oDoc, oFolder)
	
	Next

	
	ThisApplication.StatusBarText = "Done!!!!!"
End Sub
	'=========================================================
	

Sub DXF_Out(ByRef oDoc As Document, oFolder As String)
	oCreated_Flat = False
	oFullFileName = oDoc.FullFileName
	oFileName = Right(oFullFileName, Len(oFullFileName) - InStrRev(oFullFileName, "\"))
	oName = Left(oFileName, InStrRev(oFileName, ".") - 1) 'name without extension	
	'look at only Sheet metal parts
	If oDoc.SubType = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Then
		Logger.Info("File Name: " & oFileName)
		Logger.Info("Is Sheetmetal")
		Dim oCompDef As SheetMetalComponentDefinition
		oCompDef = oDoc.ComponentDefinition		
		
		i = 0
		Logger.Info("Looking at solid bodies....")
		For Each oBody In oCompDef.SurfaceBodies
			If oBody.IsSolid = True Then
				i = i +1
			End If
		Next

		If i > 1 Then
		 	Exit Sub
		End If 
		Logger.Info(".....solid bodies ok")

		'check for flat pattern	
		If oCompDef.HasFlatPattern = False Then 
			Logger.Info("HasFlatPattern: " & oCompDef.HasFlatPattern)
			Logger.Info("/////////////\\\\\\\\\\\\ Trying to create flatpattern...")
			Try
				oCompDef.Unfold 
				oCreated_Flat = True
			Catch ex As Exception
				oCreated_Flat = False
				Logger.Info("Problem creating flat!!!!")
				Logger.Info(ex.Message)
			End Try
		Else 'if flat pattern exists
			Logger.Info("HasFlatPattern: " & oCompDef.HasFlatPattern)
			Logger.Info("Trying to get flatpattern...")
			ThisApplication.Documents.Open(oFullFileName, True)
			Try
				oCompDef.FlatPattern.Edit 
			Catch ex As Exception
				Logger.Info("Problem editing flat!!!!")
				Logger.Info(ex.Message)
			End Try
		End If
    
	Dim sOut As String
      sOut = "FLAT PATTERN DXF?AcadVersion=2018" _
	  + "&BendUpLayer=IV_BEND" _
	  + "&BendDownLayer=IV_BEND_DOWN" _
	  + "&BendUpLayerColor=255;0;255" _
	  + "&BendDownLayerColor=255;0;255" _
	  + "&FeatureProfilesUpLayer=IV_FEATURE_PROFILES" _
	  + "&FeatureProfilesDownLayer=IV_FEATURE_PROFILES_DOWN" _
	  + "&FeatureProfilesUpLayerColor=0;255;255" _
	  + "&FeatureProfilesDownLayer=0;255;255" _
	  + "&OuterProfileLayer=IV_OUTER_PROFILE" _
	  + "&OuterProfileLayerColor=0;255;255" _
	  + "&InteriorProfilesLayer=IV_IV_INTERIOR_PROFILES" _
	  + "&InteriorProfilesLayerColor=0;255;255" _
	  + "&InvisibleLayers=IV_TANGENT;IV_ROLL_TANGENT;IV_TOOL_CENTER;IV_ARC_CENTERS;IV_TOOL_CENTER_DOWN" 
	  
	'EINDE TOEVOEGING
	
	Dim oCommand As CommandManager = ThisApplication.CommandManager
	
	sFullDXFname = oFolder & "\" & oName & ".dxf"
	oCompDef.DataIO.WriteDataToFile(sOut, sFullDXFname)
	
Try
			Logger.Info("DXF created!!!:  " & sFullDXFname)
		Catch ex As Exception
			Logger.Info("Problem creating DXF!!!!")
			Logger.Info(ex.Message)
		End Try		
		
		oCompDef.FlatPattern.ExitEdit
		
		Try
			If oCreated_Flat = True Then oDoc.Save
		Catch ex As Exception
			Logger.Info("Saving the file.")
			Logger.Info(ex.Message)
		End Try
		
		oDoc.Close
		Logger.Info("*******************")
	oCompDef.FlatPattern.ExitEdit
	
End If

End Sub

Public Function AddDXFProperties(Optional JustReturnText As Boolean = False) As String


Dim PartNumber As String = "PartNumber: " & UCase(iProperties.Value("Project", "Part Number")) 'false = without extension '(iProperties.Value("Project", "Part Number")) 'without extension

Dim sText As String = PartNumber 

If JustReturnText = False Then

	extents_length = SheetMetal.FlatExtentsLength
	extents_width = SheetMetal.FlatExtentsWidth

	PosX = extents_length/2

	PosY = extents_width/-2

	Call EditDXFFile(PartNumber, PosX, PosY, FullDXFname, "1D5")
End If

AddDXFProperties = sText

End Function

Public Sub EditDXFFile(TextToAdd As String, PosX As Double, PosY As Double, FullDXFname 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() 

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

	sFname = oPath & "\" & FullDXFname & ".dxf" 
	
	Dim readText As String = System.IO.File.ReadAllText(oFilename) 
	
	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(FullDXFname, readText) 

End Sub

[daltonNYAW9]

Heres a good example of how to add a 'Mark feature' to a part:
http://www.hjalte.nl/82-addmarkfeature

You will need to change the 'PartComponentDefinition' to a 'FlatPattern' so the mark will only show up on the flat pattern. I got it to work only chaning a few lines from the above link:

Dim doc As PartDocument = ThisDoc.Document
Dim def As SheetMetalComponentDefinition = doc.ComponentDefinition

Dim face As Face = def.FlatPattern.TopFace
Dim pointOnFace As Point = ThisApplication.TransientGeometry.CreatePoint(1, 2, 0)

'Private Sub CreateMarkFeatur
'....
Dim markFeatures As MarkFeatures = def.FlatPattern.Features.MarkFeatures
'End Sub