AnsweredAssumed Answered

Need help tweaking a macro script to batch export SW parts to DXF files

Question asked by Mahmoud Abdelaziz on Dec 6, 2019

Hello Guys, sorry for asking you this repeated question, I have this macro file to export SW parts to DXF but the problem is when saving many faces in a multibody part, it always save the new file with the same name as the old file which overwrites is, what I need is to tweak the macro script to give the file name any extension if it finds the file already existing, but my VBA skills are close to none so please someone help me !!


The code I found was this one:


Option Explicit

Sub exportDXF()

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swPart As SldWorks.PartDoc
Dim swSelMgr As SelectionMgr
Dim swSelData As SelectData
Dim swFace As Face2
Dim swSurf As Surface
Dim sModelName As String
Dim sPathName As String
Dim varAlignment As Variant
Dim dataAlignment(11) As Double
Dim varViews As Variant
Dim dataViews(1) As String
Dim options As Long
Dim exportType As String
Dim numSel As Integer
Dim selType As Integer
Dim result As Boolean
Dim i As Integer

'*** Change to dxf or dwg depending on which file type you want to export
exportType = "dxf" '"dwg"

'Get Solidworks and and active model
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc

'Make sure a model is open
If swModel Is Nothing Then
MsgBox ("Error! No model open")
Exit Sub
End If

'Make sure model is part
If swModel.GetType = swDocPART Then
Set swPart = swModel
MsgBox ("Error! Must use part document")
Exit Sub
End If

'Set the selection manager and get the number of selections
Set swSelMgr = swModel.SelectionManager
numSel = swSelMgr.GetSelectedObjectCount2(-1)

'Make sure at least one face is selected
If numSel < 1 Then
MsgBox ("Error! Please select at least one planar face to export")
Exit Sub
End If

'Check all selections are planar faces
For i = 1 To numSel

Set swFace = swSelMgr.GetSelectedObject6(i, -1)
Set swSurf = swFace.GetSurface

'Exit for nonplanar surface
If swSurf.IsPlane = False Then
MsgBox ("Error! Non planar surface selected")
Exit Sub
End If

Next i

'Get the pathname
sModelName = swModel.GetPathName
sPathName = swModel.GetPathName

'Make sure the path is something
If sPathName = "" Then
MsgBox ("Error! File not saved")
Exit Sub
End If

'change the file extension to dxf (or dwg)
sPathName = Left(sPathName, Len(sPathName) - 6)
sPathName = sPathName + exportType

'Define the alignment types
'I had to set them all to 0 in order to output in same orientation as 3D model
dataAlignment(0) = 0#
dataAlignment(1) = 0#
dataAlignment(2) = 0#
dataAlignment(3) = 0#
dataAlignment(4) = 0#
dataAlignment(5) = 0#
dataAlignment(6) = 0#
dataAlignment(7) = 0#
dataAlignment(8) = 0#
dataAlignment(9) = 0#
dataAlignment(10) = 0#
dataAlignment(11) = 0#

varAlignment = dataAlignment

'Export the selected face(s) to a DXF/DWG
result = swPart.ExportToDWG2(sPathName, sModelName, swExportToDWG_ExportSelectedFacesOrLoops, True, varAlignment, False, False, options, Nothing)

'Show error message if failed to save
If result = False Then
MsgBox ("Error! Failed to export. Check selections and try again.")

Else: MsgBox "DXF file successfully saved! "
Exit Sub
End If

End Sub