AnsweredAssumed Answered

Export as .dxf from weldment + custom properties

Question asked by Edd Collins on May 5, 2019
Latest reply on May 6, 2019 by Peter Brinkhuis

Hello all,

 

We have been playing around with an excellent macro from these forums >> Selecting a face and then clicking a macro button to create DXF

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

Outcomes