11-24-2015
11:53 PM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
11-24-2015
11:53 PM
Flatpattern - Polyline - Info DWG
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