Hello all,

We have been playing around with an excellent macro from these forums >>

This has been modified to save to our particular saving location & drag specific custom properties to name the file from the sheetmetal part... all good there!

When exporting to DXF we need to map the file with bend line colours, so my thought was to modify the export code based on 2014 SOLIDWORKS API Help - swExportToDWG_e Enumeration :

"swExportToDWG_ExportSelectedFacesOrLoops" to "swExportToDWG_ExportSheetMetal" to enable to use of the DXF mapping tool

However when changed, the macro is producing no output.

Perhaps this was the wrong macro to start with? All help appreciated. Code below..

Option Explicit
' LATEST REVISION 06MAY2019 EDD - NOT SAVING AS SHEETMETAL
Sub Main()
Dim swApp               As SldWorks.SldWorks
Dim Part                As SldWorks.ModelDoc2
Dim swFace              As SldWorks.Face2
Dim swBody              As SldWorks.Body2
Dim feat                As SldWorks.Feature
Dim swCustPropMgr       As SldWorks.CustomPropertyManager
Dim SelMgr              As SldWorks.SelectionMgr
Dim BodyFolder          As SldWorks.BodyFolder
Dim CutListBdy          As Body2
Dim strValue(10)        As String
Dim WorkFace            As Face2
Dim WorkSurface         As Surface
Dim savepathdxf         As String
Dim varAlignment        As Variant
Dim dataAlignment(11)   As Double
Dim seltype             As Integer
Dim i                   As Integer
Dim isThisAPlane        As Boolean
Dim vBodies             As Variant
Dim j                   As Integer
Dim wasResolved         As Boolean
Dim itemnumber As Variant
Const SaveLoc           As String = "R:\CUSTOMER BUILDS\- RECENT PDF FILES\RECENT FILES - EDD\TESTING\" 'Change Path here
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
'Don't run if no part is loaded
If Part Is Nothing Then
    swApp.SendMsgToUser "There is no part loaded."
    GoTo cleanupandquitnopart
End If
'did the user have the open file saved
If Part.GetPathName = "" Then
        'user does not have open file saved
        swApp.SendMsgToUser "Please save the file before running this script."
        GoTo cleanupandquit
End If
Set swCustPropMgr = Part.Extension.CustomPropertyManager("")
'Get Custom Property Project
swCustPropMgr.Get5 "Project", False, strValue(8), strValue(0), wasResolved
'Get Custom Property Number
swCustPropMgr.Get5 "Number", False, strValue(9), strValue(1), wasResolved
'did the user pre-select a face?
Set SelMgr = Part.SelectionManager
If SelMgr.GetSelectedObjectCount2(1) <> 1 Then
seltype = SelMgr.GetSelectedObjectType3(1, 0)
    If seltype <> SwConst.swSelFACES Then
        'user did not preselect one face
        swApp.SendMsgToUser "Please select a (one) 2D face before running this command."
        GoTo cleanupandquit
     Else
           
    Set swFace = SelMgr.GetSelectedObject6(1, -1)
    Set swBody = swFace.GetBody
        
    Set feat = Part.FirstFeature
    While Not feat Is Nothing
        If feat.GetTypeName = "CutListFolder" Or feat.GetTypeName = "SubWeldFolder" Then
            Set BodyFolder = feat.GetSpecificFeature2
            vBodies = BodyFolder.GetBodies
            If Not IsEmpty(vBodies) Then
            For j = LBound(vBodies) To UBound(vBodies)
                Set CutListBdy = vBodies(j)
                If CutListBdy.Name = swBody.Name Then
                Set swCustPropMgr = feat.CustomPropertyManager
                    'Get Custom Property PART NO from cut list
                        swCustPropMgr.Get5 "PART NO", False, strValue(5), strValue(2), wasResolved
                    'Get Custom Property REV (REVISION) from cut list
                        swCustPropMgr.Get5 "REV", False, strValue(6), strValue(3), wasResolved
                itemnumber = feat.Name
                End If
            Next j
            End If
        End If
        Set feat = feat.GetNextFeature()
    Wend
       
    End If
End If
'Determine if the selected face is a true 2D plane... exit if not
isThisAPlane = False  'initalize variable to false
'make sure that what is selected is a face... exit if not
If SelMgr.GetSelectedObjectType3(1, -1) <> 2 Then
    swApp.SendMsgToUser "Item selected is not a face. You must select a (one) complete 2D Face to export."
    GoTo cleanupandquit
End If
Set WorkFace = SelMgr.GetSelectedObject5(1)
Set WorkSurface = WorkFace.GetSurface
isThisAPlane = WorkSurface.IsPlane
If isThisAPlane = False Then
    swApp.SendMsgToUser "The face selected is not 2D. Please select a (one) 2D face before running this command."
    GoTo cleanupandquit
End If
    
        
'Save a DXF
    dataAlignment(0) = 0#
    dataAlignment(1) = 0#
    dataAlignment(2) = 0#
    dataAlignment(3) = 1#
    dataAlignment(4) = 0#
    dataAlignment(5) = 0#
    dataAlignment(6) = 0#
    dataAlignment(7) = 1#
    dataAlignment(8) = 0#
    dataAlignment(9) = 0#
    dataAlignment(10) = 0#
    dataAlignment(11) = 1#
    varAlignment = dataAlignment
'Clean off the file name so that we can add our desired name
'savepathdxf = SaveLoc
'### previous code = 'Left(Part.GetPathName, InStrRev(Part.GetPathName, "\"))
'File name in the standard of PART NO & REV & .DXF
savepathdxf = SaveLoc & strValue(5) & " " & strValue(6) & ".DXF"
'Export selected face to a DXF
Part.ExportToDWG2 savepathdxf, Part.GetPathName, swExportToDWG_ExportSelectedFacesOrLoops, True, varAlignment, False, False, 101, Null
Part.ClearSelection2 False
GoTo cleanupandquit
'#############################################################
'DRAWING (this macro started while a drawing was active )
'#############################################################
GoTo cleanupandquit
cleanupandquit:
Part.DeleteConfiguration (Part.GetActiveConfiguration.Name & "SM-FLAT-PATTERN")
Set swApp = Nothing
Set Part = Nothing
Set SelMgr = Nothing
cleanupandquitnopart:  'only called if no part is loaded
Set swApp = Nothing
Set Part = Nothing
Set SelMgr = Nothing
End Sub