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.
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
Solved! Go to Solution.
Solved by JhoelForshav. Go to Solution.
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?
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
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!
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
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
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
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. *???*
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
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.
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"...
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.
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.
Can't find what you're looking for? Ask the community or share your knowledge.