Message 1 of 1
Export flat pattern in dxf
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hello, i found this code below to export a flat pattern of a sheet ipt in this community.
This code works good but i have some questions about it:
-is it possible to change the color of the text in the dxf in yellow and change the style of the text?
-is it possible to add bendnotes on the bendlines in the dxf? In case yes they can be added
without ° in Angle and without R & Bendradius?
Thanks a lot for you work.
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
