Announcements
Attention for Customers without Multi-Factor Authentication or Single Sign-On - OTP Verification rolls out April 2025. Read all about it here.

Flatpattern - Polyline - Info DWG

martinhoos
Advocate

Flatpattern - Polyline - Info DWG

martinhoos
Advocate
Advocate

Hello Forum,

the following code works pretty good, but there are three problems;

 

first - the outercontour is not a polyline

second - the DWG file doesnt work (if i go by hand to the options, i can say take this DWG into the DXF, it has information in)

third - is there a solution to get only the upper face of the flat pattern into the dxf?

 

Hopefully, there is one in here who can help me...

Regards

Martin

 

 

Sub Main
DefaultChoice = True
CadlinePathProperty()
Cadline()
End Sub
Sub CadlinePathProperty()
Dim FilePATH As String = "FilePATH"
Dim FileINDEX As String = "FileINDEX"
customPropertySet = ThisDoc.Document.PropertySets.Item _
("Inventor User Defined Properties")
Try
         prop= customPropertySet.Item(FilePATH)
Catch
            customPropertySet.Add("", FilePATH)
End Try
customPropertySet = ThisDoc.Document.PropertySets.Item _
("Inventor User Defined Properties")
Try
         prop= customPropertySet.Item(FileINDEX)
Catch
            customPropertySet.Add("", FileINDEX)
End Try
If iProperties.Value("Custom", "FilePATH") = "" Then
iProperties.Value("Custom", "FilePATH") = "u:\trans\"
Else
End If
Dim partDoc As PartDocument
If ThisApplication.ActiveDocument.DocumentType <> kPartDocumentObject Then
MessageBox.Show ("Please open a part document", "iLogic")
End If
'FilePATH = InputBox("Enter a FilePATH for part file", "iLogic", iProperties.Value("Custom", "FilePATH"))
'iProperties.Value("Custom", "FilePATH") = FilePATH
FileINDEX = InputBox("Bitte Änderungs-Index eingeben, z.B. A00", "iLogic", iProperties.Value("Custom", "FileINDEX"))
iProperties.Value("Custom", "FileINDEX") = FileINDEX
End Sub
Public Sub Cadline()
    Dim oDoc As PartDocument
    oDoc = ThisApplication.ActiveDocument
    Dim oCompDef As SheetMetalComponentDefinition
    oCompDef = oDoc.ComponentDefinition
     If oCompDef.HasFlatPattern = False Then
     oCompDef.Unfold
    Else
    oCompDef.FlatPattern.Edit
    End If
    Dim sOut As String
    Dim sPATH As String
    sPATH = iProperties.Value("Custom", "FilePATH")
	Dim sINDEX As String
    sINDEX = iProperties.Value("Custom", "FileINDEX")
	sOut = "FLAT PATTERN DXF?AcadVersion=2000" _
			+ "&OuterProfileLayer=0" _
			+ "&IV_FEATURE_PROFILES=" _
			+ "&IV_INTERIOR_PROFILES=" _
			+ "&InvisibleLayers=IV_UNCONSUMEND_SKETCHES;IV_ALTREP_BACK;IV_ALTREP_FRONT;IV_ARC_CENTERS;IV_TOOL_CENTER_DOWN;IV_TOOL_CENTER;IV_ARC_CENTERS;IV_TANGENT;IV_BEND;IV_FEATURE_PROFILES_DOWN;IV_BEND_DOWN" _
			+ "&SplineTolerance Double 0.01" _
			+ "&MergeProfilesIntoPolyline=TRUE" _
			+ "&MergeOuterContour=TRUE" _
			+ "&AUTOCADTEMPLATE=I:\DXF\hinweis_dxfout.dwg" _
			+ "&MODELGEOMETRYONLY=Yes"	  
	Dim sFname As String
    sFname = sPATH & "\" & ThisDoc.FileName(False) & "-" & sINDEX & ".dxf"
    MessageBox.Show("DXF SAVED TO: " & sFname ,"DXF Saved", MessageBoxButtons.OK)
    oCompDef.DataIO.WriteDataToFile( sOut, sFname)
  oDoc = ThisApplication.ActiveDocument
Dim oSMDef As SheetMetalComponentDefinition
oSMDef = oDoc.ComponentDefinition
oSMDef.FlatPattern.ExitEdit
'This code has been adapted from http://www.cadlinecommunity.co.uk/Blogs/Blog.aspx?ScoId=
'4733ef2d-cd48-4bd9-a280-1d88dbbf3556&returnTo=%2fBlogs%2fclintonbrown%2fDefault.aspx
'&returnTitle=Clinton+Brown%20Blog
End Sub

 
0 Likes
Reply
250 Views
1 Reply
Reply (1)

martinhoos
Advocate
Advocate

... no ideas?

0 Likes