Flat Pattern to DXF

[Anonymous]

Hello,

I now there are many version of this out there and that is where i got what I have so far.  My knowldege of coding is very limited and I don't have time now to learn but i really need this to work.

This code will give the the dxf but will no file name.  I would like it to have the same file name as the part # followed by -Revsion.

any help will be appreciated.

Thank you.

Frank 

Sub FlatPatternDXF()

Dim oPartDoc As Document
Set oPartDoc = ThisApplication.ActiveDocument

' The Active document must be a part
If oPartDoc.DocumentType <> kPartDocumentObject Then
MsgBox "The Active document must be a 'Part'"
Exit Sub
End If

' The Active document must be a Sheet metal Part
If oPartDoc.SubType <> "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Then
MsgBox "The Active document must be a 'Sheet Metal Part'"
Exit Sub
End If

Dim oFlatPattern As FlatPattern
Set oFlatPattern = oPartDoc.ComponentDefinition.FlatPattern

' There must be a flat pattern
If oFlatPattern Is Nothing Then
MsgBox "Please create the flat pattern"
Exit Sub
End If

Dim oDataIO As DataIO
Set oDataIO = oPartDoc.ComponentDefinition.DataIO

Dim sOut As String

sOut = "FLAT PATTERN DXF?AcadVersion=2000" _
+ "&OuterProfileLayer=OUTER_PROF&OuterProfileLayerColor=0;0;0" _
+ "&InteriorProfilesLayer=INNER_PROFS&InteriorProfilesLayerColor=0;0;0" _
+ "&FeatureProfileLayer=FEATURE&FeatureProfileLayerColor=0;0;0" _
+ "&BendUpLayer=BEND_UP&BendUpLayerColor=0;255;0&BendUpLayerLineType=37634" _
+ "&BendDownLayer=BEND_DOWN&BendDownLayerColor=0;255;0&BendDownLayerLineType=37634" _

Dim strProject As String
strProject = oPartDoc.PropertySets("Design Tracking Properties").Item("Project").Value

Dim strPath As String
strPath = "D:\Dropbox\Concept DXF\"

Dim oDXFfileNAME As String
oDXFfileNAME = strPath & strProject & ".dxf"

oDataIO.WriteDataToFile sOut, oDXFfileNAME


End Sub

[MechMachineMan · Accepted solution]

Assuming that by revision you mean the revision number iProperty...

Sub FlatPatternDXF()

'config
    'Change values located here to change output.
    Dim strPath As String
    strPath = "C:\Users\Public\Documents\"  'Must end with a "\"
    
    Dim sOut As String
    sOut = "FLAT PATTERN DXF?AcadVersion=2000" _
    + "&OuterProfileLayer=OUTER_PROF&OuterProfileLayerColor=0;0;0" _
    + "&InteriorProfilesLayer=INNER_PROFS&InteriorProfilesLayerColor=0;0;0" _
    + "&FeatureProfileLayer=FEATURE&FeatureProfileLayerColor=0;0;0" _
    + "&BendUpLayer=BEND_UP&BendUpLayerColor=0;255;0&BendUpLayerLineType=37634" _
    + "&BendDownLayer=BEND_DOWN&BendDownLayerColor=0;255;0&BendDownLayerLineType=37634" _
'/config

    Dim oPartDoc As Document
    Set oPartDoc = ThisApplication.ActiveDocument
    
    Dim oFlatPattern As FlatPattern
    
'Pre-processing check:
    ' The Active document must be a Sheet metal Part with a flat pattern
    If oPartDoc.DocumentType <> kPartDocumentObject Then
        MsgBox "The Active document must be a 'Part'"
        Exit Sub
    Else
        If oPartDoc.SubType <> "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Then
            MsgBox "The Active document must be a 'Sheet Metal Part'"
            Exit Sub
        Else
            Set oFlatPattern = oPartDoc.ComponentDefinition.FlatPattern
            If oFlatPattern Is Nothing Then
                MsgBox "Please create the flat pattern"
                Exit Sub
            End If
        End If
    End If
    
'Processing:
    Dim oDataIO As DataIO
    Set oDataIO = oPartDoc.ComponentDefinition.DataIO
    
    Dim strPartNum As String
    strPartNum = oPartDoc.PropertySets("Design Tracking Properties").Item("Part Number").Value

    Dim strRev As String
    strRev = oPartDoc.PropertySets("Inventor Summary Information").Item("Revision Number").Value
    
    Dim oDXFfileNAME As String
    oDXFfileNAME = strPath & strPartNum & "-R" & strRev & ".dxf"
    
    Call oDataIO.WriteDataToFile(sOut, oDXFfileNAME)

    'Toggle this on/off to open output folder during output.
    Call Shell("explorer.exe" & " " & strPath, vbNormalFocus)

End Sub

[Anonymous]

Much Thanks, that worked great.

[JasonMayes]

I have used a modified version of this code as a macro and it works great. I do have a question however... Is it possible to turn off holes up to a certain diameter and just leave center points? Here is the macro I am running currently. @Curtis_Waguespack

Sub FlatPatternDXF()
'config
'Change values located here to change output.
Dim strPath As String
strPath = "R:\email\" 'Must end with a "\"
Dim sOut As String
sOut = "FLAT PATTERN DXF?AcadVersion=2004&OuterProfileLayer=Outer;IV_Arc_Centers&InvisibleLayers=IV_Tangent;IV_Bend;IV_Bend_Down;IV_Bend_Up"

'/config
Dim oPartDoc As Document
Set oPartDoc = ThisApplication.ActiveDocument
Dim oFlatPattern As FlatPattern

'Pre-processing check:
' The Active document must be a Sheet metal Part with a flat pattern
If oPartDoc.DocumentType <> kPartDocumentObject Then
MsgBox "The Active document must be a 'Part'"
Exit Sub
Else
If oPartDoc.SubType <> "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Then
MsgBox "The Active document must be a 'Sheet Metal Part'"
Exit Sub
Else
Set oFlatPattern = oPartDoc.ComponentDefinition.FlatPattern
If oFlatPattern Is Nothing Then
MsgBox "Please create the flat pattern"
Exit Sub
End If
End If
End If

'Processing:
Dim oDataIO As DataIO
Set oDataIO = oPartDoc.ComponentDefinition.DataIO
Dim strPartNum As String
strPartNum = oPartDoc.PropertySets("Design Tracking Properties").Item("Part Number").Value
Dim strRev As String
strRev = oPartDoc.PropertySets("Inventor Summary Information").Item("Revision Number").Value
Dim oDXFfileNAME As String
oDXFfileNAME = strPath & strPartNum & ".dxf"
Call oDataIO.WriteDataToFile(sOut, oDXFfileNAME)
MsgBox "DXF has been created in R:\email"
'Toggle this on/off to open output folder during output.
'Call Shell("explorer.exe" & " " & strPath, vbNormalFocus)
End Sub

[Anonymous]

When I try to use this in Inventor 2018 it says that "let and set assignment statements are no longer supported, and that method arguments must be enclosed in parentheses.  I know nothing about code and if you know how to fix this it would be very helpful.

[SometimesInventorMakesMeAngry]

I think you were trying to paste the code into an iLogic rule, which uses VB.NET. You should paste it into a VBA module, which can be accessed via Inventor's VBA editor.