AnsweredAssumed Answered

Help with this assembly to DXF macro

Question asked by Brock Talley on Jul 25, 2019

Sorry in advance if this question has been beat to death. I actually got this macro from the forum and it works great I just would like to edit it to make it easier for what I do. I'll post the macro below this explanation. 


So it takes the assembly opens up the part and exports it as a DXF with bendlines which is exactly what I need but I would like the option of being able to select which folder it saves too I'd appreciate any help with this thank you in advance.


Sub main()



   Dim swApp                       As SldWorks.SldWorks

   Dim swModel                     As SldWorks.ModelDoc2

   Dim swAssy                      As SldWorks.AssemblyDoc

   Dim swConf                      As SldWorks.Configuration

   Dim swRootComp                  As SldWorks.Component2

   Dim nStart                      As Single

   Dim bRet                        As Boolean


   Set swApp = Application.SldWorks

   Set swModel = swApp.ActiveDoc

   Set swConf = swModel.GetActiveConfiguration

   Set swRootComp = swConf.GetRootComponent3(True)


   Debug.Print "File = " & swModel.GetPathName


   TraverseComponent swRootComp, 1


   Debug.Print "Finished!"



End Sub



Sub TraverseComponent(swComp As SldWorks.Component2, nLevel As Long)



Dim vChildComp                  As Variant



   Dim swApp                       As SldWorks.SldWorks

   Dim swpart                      As SldWorks.PartDoc


   Dim swChildComp                 As SldWorks.Component2

   Dim swConfig                    As SldWorks.Configuration

   Dim swConfMgr                   As SldWorks.ConfigurationManager

   Dim swChildModel                As SldWorks.ModelDoc2

   Dim swOpenModel                 As SldWorks.ModelDoc2


   Dim swChildCustPropMngr         As CustomPropertyManager

   Dim swChildModelDocExt          As ModelDocExtension

   Dim swsheetmetal                As SldWorks.SheetMetalFeatureData

   Dim swFeat                      As SldWorks.Feature

   Dim swBody                      As SldWorks.Body2



   Dim Sheet_metal                 As Boolean

   Dim Boolstatus                  As Boolean


   Dim Thickness                   As Double

   Dim conv                        As Double



   Dim i                           As Long

   Dim loptions                    As Long

   Dim lerrors                     As Long



   Dim sPadStr                     As String

   Dim FilePath                    As String

   Dim FileName                    As String

   Dim swThkDir                    As String

   Dim swMatDir                    As String

   Dim swCurrent                   As String

   Dim RefCfg                      As String

   Dim ChildConfigName             As String

   Dim sMatName                    As String

   Dim sMatDB                      As String

   Dim exFileName                  As String


   Dim Bodies                      As Variant


   vChildComp = swComp.GetChildren



   For i = 0 To UBound(vChildComp)

       Set swChildComp = vChildComp(i)


       'Check to see if current component is suppressed

       If swChildComp.IsSuppressed = False Then GoTo Active Else GoTo Skip



Set swApp = Application.SldWorks



Set swChildModel = swChildComp.GetModelDoc2

   'Check to see if child component is an Assembly or part

   If (swChildModel.GetType <> swDocPART) Then GoTo Jump 'Skips Subassemby level



Set swpart = swChildModel 'Applies part commands for current component



FilePath = Left(swComp.GetPathName, InStrRev(swComp.GetPathName, "\") - 1)


FileName = swChildModel.GetTitle 'Get title of component

swCurrent = swChildComp.ReferencedConfiguration 'Get current configuration of component



Bodies = swpart.GetBodies2(swBodyType_e.swAllBodies, True)

Set swBody = Bodies(0)



   If swBody.IsSheetMetal = 0 Then 'If Body is not sheet metal



       'Debug.Print "Component " & FileName & " is not a sheet metal component"

       'Debug.Print "Current Config is : "; swCurrent

           GoTo Jump

   End If


   If swBody.IsSheetMetal = 1 Then 'If body is sheet metal



       Debug.Print "Processing component " & FileName & " as a sheet metal component"

       Debug.Print "Current Config is : "; swCurrent

       GoTo Process

   End If






'Get Part Material



Set swpart = swChildModel

sMatName = swpart.GetMaterialPropertyName2(swCurrent, sMatDB)



If sMatName = "" Then sMatName = "None"



Debug.Print "    Current material is : "; sMatName



'Get part Thickness



Set swFeat = swChildModel.FirstFeature

   While Not swFeat Is Nothing



   If swFeat.GetTypeName = "SheetMetal" Then

       Set swsheetmetal = swFeat.GetDefinition


       Thickness = swsheetmetal.Thickness


       conv = 39.3700787401575

       Thickness = Thickness * conv



Debug.Print "    Thickness is :"; Thickness; "inches"


   End If



Set swFeat = swFeat.GetNextFeature




swMatDir = FilePath & "\" & sMatName

Debug.Print swMatDir



If Dir(swMatDir, vbDirectory) = "" Then MkDir swMatDir



swThkDir = FilePath & "\" & sMatName & "\" & Thickness

Debug.Print swThkDir



If Dir(swThkDir, vbDirectory) = "" Then MkDir swThkDir



exFileName = FilePath & "\" & sMatName & "\" & Thickness & "\" & FileName & "-" & swCurrent



Debug.Print exFileName



Set swOpenModel = swApp.ActivateDoc3(swChildModel.GetPathName, True, loptions, lerrors)



Boolstatus = swChildModel.ShowConfiguration2(swCurrent)



swChildModel.ExportFlatPatternView exFileName & ".DXF", 0



swApp.CloseDoc (swChildModel.GetPathName)




GoTo Jump





   Debug.Print "Skipped"




       TraverseComponent swChildComp, nLevel + 1

          Next i



End Sub