Export SOLIDWORKS files to foreign formats via Macro+ framework

Edit ArticleEdit Article

Macro+ FrameworkThis is a Macro+ enabled VBA macro. Paste the code into a new macro and add the reference to Xarial.CadPlus.MacroPlus.tlb (Macro+ COM API for CAD+ Toolset for SOLIDWORKS) type library from the installation folder of CAD+ Toolset
This macro supports arguments, logs and outputs results. It can be used in Toolbar+, Batch+ Stand-Alone+, Batch+ Integrated and Batch+ for SOLIDWORKS PDM

This VBA macro is Macro+ enabled macro that allows exporting file as to foreign format (e.g. PDF, DWG, STEP, IGES, Parasolid etc.).

Each argument of the macro should specify the output file path and the extension of the exported file.

If specified path is relative than the file will be exported relatively to the input file.

Macro will automatically created directories if needed.

'#Const TEST = True

Private Declare PtrSafe Function PathIsRelative Lib "shlwapi" Alias "PathIsRelativeA" (ByVal pszPath As String) As Boolean

Dim swApp As SldWorks.SldWorks

Sub main()

    Set swApp = Application.SldWorks
        
    Dim macroOper As IMacroOperation
    Set macroOper = GetMacroOperation()
    
    Dim vArgs As Variant
    vArgs = macroOper.Arguments
    
    Dim swModel As SldWorks.ModelDoc2
    Set swModel = macroOper.model
        
    Dim resFilePaths() As String
    ReDim resFilePaths(UBound(vArgs))
        
    For i = 0 To UBound(vArgs)
        
        Dim macroArg As IMacroArgument
        Set macroArg = vArgs(i)
        
        Dim filePath As String
        filePath = macroArg.GetValue()
        
        If PathIsRelative(filePath) Then
            
            Dim modelPath As String
            modelPath = swModel.GetPathName
            
            If modelPath <> "" Then
                filePath = GetDirectory(modelPath) & filePath
            Else
                Err.Raise vbError, "", "Cannot use relative path for an unsaved model"
            End If
        
        End If
               
        resFilePaths(i) = filePath
        
    Next
    
    Dim vResFiles As Variant
    vResFiles = macroOper.SetResultFiles(resFilePaths)
    
    For i = 0 To UBound(vResFiles)
        
        Dim resFile As IMacroOperationResultFile
        Set resFile = vResFiles(i)
                
        TryExport swModel, resFile, macroOper
                 
    Next
    
End Sub

Sub TryExport(model As SldWorks.ModelDoc2, resFile As IMacroOperationResultFile, macroOper As MacroOperation)

try_:
    On Error GoTo catch_
    
    Dim filePath As String
    filePath = resFile.path
    
    Dim errs As Long
    Dim warns As Long
    Dim dir As String
    
    dir = GetDirectory(filePath)
    
    CreateDirectories dir
    
    If False <> model.Extension.SaveAs2(filePath, swSaveAsVersion_e.swSaveAsCurrentVersion, swSaveAsOptions_e.swSaveAsOptions_Silent, Nothing, "", False, errs, warns) Then
        resFile.Status = MacroOperationResultFileStatus_e_Succeeded
    Else
        Err.Raise vbError, "", "Failed to export to '" & filePath & "'. Error code: " & errs
    End If

    GoTo finally_
catch_:
    macroOper.ReportIssue Err.Description, MacroIssueType_e_Error
    resFile.Status = MacroOperationResultFileStatus_e_Failed
finally_:
    
End Sub

Function GetMacroOperation() As IMacroOperation
    
    Dim macroOper As IMacroOperation
    
    #If TEST Then
        Dim swCadPlusFact As Object
        Set swCadPlusFact = CreateObject("CadPlusFactory.Sw")
        
        Set swCadPlus = swCadPlusFact.Create(swApp, False)
        
        Dim args(1) As String
        args(0) = "MFGs\STEP\{ path [FileNameWithoutExtension] }.step"
        args(1) = "MFGs\IGES\{ path [FileNameWithoutExtension] }.igs"
        Set macroOper = swCadPlus.CreateMacroOperation(swApp.ActiveDoc, "", args)
    #Else
        Dim macroOprMgr As IMacroOperationManager
        Set macroOprMgr = CreateObject("CadPlus.MacroOperationManager")
        
        Set macroOper = macroOprMgr.PopOperation(swApp)
    #End If
    
    Set GetMacroOperation = macroOper
    
End Function

Function GetDirectory(path As String)
    GetDirectory = Left(path, InStrRev(path, "\"))
End Function

Sub CreateDirectories(path As String)

    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")

    If fso.FolderExists(path) Then
        Exit Sub
    End If

    CreateDirectories fso.GetParentFolderName(path)
    
    fso.CreateFolder path
    
End Sub

Product of Xarial Product of Xarial