Solidworks PDM Vault - Save PDF to server location that matches first 3 digits of FileName

47 Views Asked by At

When I run the 'Convert to PDF' Task, I need my files to save at a file location driven by our xxx-xxx.slddrw file naming scheme. How can I override the PDM Vault's 'Primary Output Path' to follow the code I have listed below?

The first three numbers (e.g. 574) in our file names designate what type of part we're working with and thus which folder they are saved to. I'm lost in how the PDM code is written and can't determine where I should be adding/replacing the Output Path information.

Please note, original script was 45k char and I had to remove details for .stp,.dxf,etc.

SOLIDWORKS PDM 2021 - Default Convert Task Script

Dim swApp As Object
Dim swModel As SldWorks.ModelDoc2
Dim swDrawing As SldWorks.DrawingDoc
Dim swAssembly As SldWorks.AssemblyDoc
Dim swExtension As SldWorks.ModelDocExtension
Dim swConfMgr As SldWorks.ConfigurationManager
Dim swPDFExport As SldWorks.ExportPdfData
Dim swDocSpecification As SldWorks.DocumentSpecification
Dim FileSystemObj as Object

Dim errors As Long
Dim warnings As Long
Dim Is3dPDF As Boolean
Const ForAppending = 8
Const TriStateDefault = -2

Dim bUseMapping as Boolean

Dim iDXFFormatVersion as Integer
Dim iDXFFont as Integer
Dim iDXFLineStyle as Integer
Dim bEnableEndPointMerging as Boolean
Dim bHighQualityDXFExport as Boolean
Dim dEndPoinMergingDistance as Double
Dim bSplinesExport as Boolean

Dim bUseMappingOriginal as Boolean
Dim bShowMapOriginal as Boolean
Dim MapFiles As String
Dim Idx As Integer

Dim iDXFFormatVersionOriginal as Integer
Dim iDXFFontOriginal as Integer
Dim iDXFLineStyleOriginal as Integer
Dim bEnableEndPointMergingOriginal as Boolean
Dim bHighQualityDXFExportOriginal as Boolean
Dim dEndPoinMergingDistanceOriginal as Double
Dim bSplinesExportOriginal as Boolean

Dim bNeedRestore as Boolean


#If VBA7 Then
    Private Declare PtrSafe Function SHCreateDirectoryEx Lib "shell32" Alias "SHCreateDirectoryExW" (ByVal hwnd As Long, ByVal pszPath As LongPtr, ByVal psa As Any) As Long
    Private Declare PtrSafe Function PathIsRelative Lib "shlwapi.dll" Alias "PathIsRelativeW" (ByVal pszPath As LongPtr) As Long
#Else
    Private Declare Function SHCreateDirectoryEx Lib "shell32" Alias "SHCreateDirectoryExW" (ByVal hwnd As Long, ByVal pszPath As LongPtr, ByVal psa As Any) As Long
    Private Declare Function PathIsRelative Lib "shlwapi.dll" Alias "PathIsRelativeW" (ByVal pszPath As LongPtr) As Long
#End If

Function PathAppend(path, more) As String
If Not Right(path, 1) = "\" Then
path = path & "\"
End If
If Left(more, 1) = "\" Then
more = Mid(more, 2)
End If
PathAppend = path & more
End Function

Sub Log(message)

Dim errorLogFolder As String
Dim errorLogPath As String
' Determine error log output path
errorLogFolder = "[ErrorLogPath]"
    
' Trim \ from the start
If Left(errorLogFolder, 1) = "\" Then

errorLogFolder = Mid(errorLogFolder, 2)
End If
' Build full root
If PathIsRelative( StrPtr(errorLogFolder) ) = 1 Then
    errorLogPath = PathAppend("<VaultPath>", errorLogFolder)
Else
errorLogPath = errorLogFolder
End If
Msbbox"build full root"

' Create directory if not exists
SHCreateDirectoryEx ByVal 0&, StrPtr(errorLogPath), ByVal 0&
errorLogPath = PathAppend(errorLogPath, "<TaskInstanceGuid>.log")

' Write error to output file
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFile = oFSO.OpenTextFile(errorLogPath, ForAppending, TriStateDefault)

oFile.WriteLine message
oFile.Close

End Sub

Sub CreatePath(path)
'Create directory if not exists
result = SHCreateDirectoryEx(ByVal 0&, StrPtr(path), ByVal 0&)
End Sub

Function GetExtension(docType, fileFormat)

first = InStr(1, fileFormat, "(")
last = InStr(first, fileFormat, ")")
extensions = Mid(fileFormat, first + 1, last - first - 1)
    
Is3dPDF = (StrComp(Mid(fileFormat, 1, first - 1), "3D PDF - MBD ") = 0)
    
If InStr(1, extensions, ";") > 0 Then

Dim all As Variant
all = Split(extensions, ";")
       
    

If UBound(all) >= docType - 1 Then
    

ext = all(docType - 1)
Else
    ext = "*." ' Nothing
End If

Else
ext = extensions
End If
    
GetExtension = Mid(Trim(ext), 2)
End Function

Sub SetConversionOptions(ext)

bNeedRestore = true

' PDF options
If LCase(ext) = ".pdf" Then
swApp.SetUserPreferenceToggle swPDFExportInColor, [PdfInColor]
swApp.SetUserPreferenceToggle swPDFExportEmbedFonts, [PdfEmbedFonts]
swApp.SetUserPreferenceToggle swPDFExportHighQuality, [PdfHighQuality]
swApp.SetUserPreferenceToggle swPDFExportPrintHeaderFooter, [PdfPrintHeaderFooter]
swApp.SetUserPreferenceToggle swPDFExportUseCurrentPrintLineWeights, [PdfUsePrinterLineWeights]
        
    Function ReplaceVarTags(convFileName, conf)
    Dim varDictionary: Set varDictionary = CreateObject("Scripting.Dictionary")
    
    <VarReplacerScript>
    
    localConf = conf
    
    If conf = "" Or conf = "All sheets" Or conf = "All" Then
        localConf = "@"
    End If
    
    resultFileName = convFileName
    
    If varDictionary.Exists(localConf) Then

    For Each elem In varDictionary(localConf)
        resultFileName = Replace(resultFileName, "%" & elem & "%", varDictionary(localConf).Item(elem))
    Next

End If
'replace duplicated slash and backslash that can be created if user include variables into directory path
While InStr(1,resultFileName,"\\",1) > 0 or InStr(1,resultFileName,"//",1) > 0
    resultFileName = Replace(resultFileName,"\\","\")
    resultFileName = Replace(resultFileName,"//","/")
WEnd
'SPR 1100578 for network UNC path we need \\ on the begin of path
If InStr(resultFileName, "\") = 1 Or InStr(resultFileName, "/") = 1 Then
resultFileName = Replace(resultFileName, "\", "\\", 1, 1)
resultFileName = Replace(resultFileName, "/", "//", 1, 1)
End If
ReplaceVarTags = resultFileName 

End Function

Function GetFullFileName(convFileName, conf, i, itemCount)
    ' Configuration name may include backslash. Remove it since otherwise saving will
    ' fail due a missing directory
    conf = Replace(conf, "\", "")
    conf = Replace(conf, "/", "")
    
    finalFileName = Replace(convFileName, "<Configuration>", conf)
    
    ' If no configuration
    If finalFileName = convFileName And itemCount > 0 Then
        finalFileName = Left(convFileName, InStrRev(convFileName, ".") - 1) & "_" & i & Mid(convFileName, InStrRev(convFileName, "."))
    End If

    ' Remove illegal characters from filename
    finalFileName = Replace(finalFileName, "<", "")
    finalFileName = Replace(finalFileName, ">", "")
    finalFileName = Left(finalFileName, 2) + Replace(finalFileName, ":", "", 3) ' Don't start from begin since drive has :
    finalFileName = Replace(finalFileName, "*", "")
    finalFileName = Replace(finalFileName, "?", "")
    finalFileName = Replace(finalFileName, """", "")
    finalFileName = Replace(finalFileName, "|", "")

    finalFileName =  ReplaceVarTags(finalFileName, conf)
    convFilePath = FileSystemObj.GetParentFolderName(finalFileName)
    CreatePath convFilePath
    GetFullFileName = finalFileName
End Function

Sub Convert(docFileName)
    
    ' Constants for some SolidWorks error/warning returns that may be encountered during a convert operation.        
    Const swerr_InvalidFileExtension = 256   ' the file extension differs from the SW document type.
    Const swerr_SaveAsNotSupported = 4096    ' the options selected for this convert aren't supported, output may be incomplete.
    Const swwarn_MissingOLEObjects = 512     ' the document contains OLE objects and must be opened and converted in SolidWorks.

    ' Determine type of SolidWorks file based on file extension
    If LCase(Right(docFileName, 7)) = ".sldprt" Or LCase(Right(docFileName, 4)) = ".prt" Then
        docType = swDocPART
    ElseIf LCase(Right(docFileName, 7)) = ".sldasm" Or LCase(Right(docFileName, 4)) = ".asm" Then
        docType = swDocASSEMBLY
    ElseIf LCase(Right(docFileName, 7)) = ".slddrw" Or LCase(Right(docFileName, 4)) = ".drw" Then
        docType = swDocDRAWING
    Else
        docType = swDocNONE
         If bIsSupportedExtension(Mid(docFileName, InStrRev(docFileName, ".") + 1)) = False Then
             Log "The file extension '" & Mid(docFileName, InStrRev(docFileName, ".") + 1) & "' is not supported."
             Exit Sub
         End If        
    End If
        
    ' Open document
    If docType = swDocNONE Then
        Set swModel = swApp.LoadFile4(docFileName, "", Nothing, errors)
        docType = swModel.GetType
    Else  
        Set swDocSpecification = swApp.GetOpenDocSpec(docFileName)
        swDocSpecification.DocumentType = docType 
        swDocSpecification.ReadOnly = True
        swDocSpecification.Silent = True
        swDocSpecification.ConfigurationName = ""
        swDocSpecification.DisplayState = ""
        swDocSpecification.IgnoreHiddenComponents = True 'SPR 682792, 538578, 651998 
        Set swModel = swApp.OpenDoc7(swDocSpecification)
        errors = swDocSpecification.Error

       ' Set swModel = swApp.OpenDoc6(docFileName, docType, swOpenDocOptions_Silent Or swOpenDocOptions_ReadOnly, "", errors, warnings)
    End If
    
    If errors = swFutureVersion Then
        Log "Document '" & docFileName & "' is future version."
        Exit Sub
    End If

    ' Load failed?
    If swModel Is Nothing Then
        Log "Method call ModelDoc2::OpenDoc7 for document '" & docFileName & "' failed. Error code " & errors & " returned."
        Exit Sub
    End If
    
    If Val(Left(swApp.RevisionNumber, 2)) >= 18 Then
      swApp.Frame.KeepInVisible = True
    End If

    swApp.ActivateDoc2 docFileName, True, errors
    modelPath = swModel.GetPathName()
    If modelPath = "" Then
      modelPath = docFileName
    End If
    modelFileName = Mid(modelPath, InStrRev(modelPath, "\") + 1)
    modelFileName = Left(modelFileName, InStrRev(modelFileName, ".") - 1)
    modelExtension = Mid(modelPath, InStrRev(modelPath, ".") + 1)

'--' Build destination filenames ''

'myPath=ActiveDocument.FileName
    convFileName = "[OutputPath]"
    
    Dim convFileName2 As String
    convFileName2 = "[OutputPath2]"
    Dim convFilePath2 As String
    Dim convFileNameTemp2 As String
    
    Dim bSecondOutput As Boolean
    bSecondOutput = False
    If (Len(convFileName2) > 0) Then
        bSecondOutput = True
    End If
        
    ext = GetExtension(docType, "[FileFormat]")
    
    If (True = Is3dPDF And docType = swDocDRAWING) Then
        Log "The file extension '" & Mid(docFileName, InStrRev(docFileName, ".") + 1) & "' is not supported."
        Exit Sub
    End If

    convFileName = Replace(convFileName, "<Filename>", modelFileName)
    convFileName = Replace(convFileName, "<Extension>", modelExtension)
    convFileName = convFileName & ext
    
    If bSecondOutput = True Then
        convFileName2 = Replace(convFileName2, "<Filename>", modelFileName)
        convFileName2 = Replace(convFileName2, "<Extension>", modelExtension)
        convFileName2 = convFileName2 & ext
    End If
    
    ' Set conversion options
    SetConversionOptions ext
    
    Set swExtension = swModel.Extension
    

    If docType = swDocDRAWING Then
        Dim vSheetNames As Variant
        Set swDrawing = swModel
        
        ' All sheets?
        If ([OutputSheets] And 2) = 2 Then
            vSheetNames = swDrawing.GetSheetNames
        ' Last active sheet?
        ElseIf ([OutputSheets] And 4) = 4 Then
            ReDim vSheetNames(0 to 0) As Variant
            vSheetNames(0) = swDrawing.GetCurrentSheet.GetName()
        ' Named sheet
        ElseIf ([OutputSheets] And 8) = 8 Then
            Dim vSheetNamesTemp As Variant
            vSheetNamesTemp = swDrawing.GetSheetNames
            removed = 0
            
            For i = 0 To UBound(vSheetNamesTemp)
                vSheetNamesTemp(i-removed) = vSheetNamesTemp(i)
                sheetName = vSheetNamesTemp(i)
                
                If Not sheetName Like "[NamedSheet]" Then
                    removed = removed + 1
                EndIf
            Next i
            
            If (UBound(vSheetNamesTemp) - removed) >= 0 Then
                ReDim Preserve vSheetNamesTemp(0 To (UBound(vSheetNamesTemp) - removed))
                vSheetNames = vSheetNamesTemp
            End If
        End If

        If Not IsEmpty(vSheetNames) Then
            ' Save sheets one per file
            If ([FileSheets] And 4) = 4 Then
                For i = 0 To UBound(vSheetNames)
                    Dim varSheetName        As Variant
                    swDrawing.ActivateSheet vSheetNames(i)

                    convFileNameTemp = GetFullFileName(convFileName, vSheetNames(i), i, UBound(vSheetNames))

                    If LCase(ext) = ".pdf" Then
                        Set swPDFExport = swApp.GetExportFileData(1)
                        varSheetName = vSheetNames(i)
                        swPDFExport.SetSheets swExportData_ExportSpecifiedSheets, varSheetName

                    End If

                    ' Convert the document
                    Success = swExtension.SaveAs(convFileNameTemp, swSaveAsCurrentVersion, swSaveAsOptions_Silent + swSaveAsOptions_UpdateInactiveViews, swPDFExport, errors, warnings)
                    
                    ' Save failed?
                    If Success = False Then Msgbox"Failed to Save"
                    End If
Next i
            ' Save PDF sheets to one file
            ElseIf ([FileSheets] And 2) = 2 Then
            
                If LCase(ext) = ".pdf" Then
                    Set swPDFExport = swApp.GetExportFileData(swExportPdfData)
                    swPDFExport.SetSheets swExportData_ExportSpecifiedSheets, vSheetNames
End If
                
convFileNameTemp = GetFullFileName(convFileName, "All", 0, 0)

' Convert the document
Success = swExtension.SaveAs(convFileNameTemp, swSaveAsCurrentVersion, swSaveAsOptions_Silent + swSaveAsOptions_UpdateInactiveViews, swPDFExport, errors, warnings)
                
' Save failed?
If Success = False Then Msbox"Save Failed No2"
End If
                
If bSecondOutput = True Then
                    convFileNameTemp2 = GetFullFileName(convFileName2, "All", 0, 0)
                    Success = swExtension.SaveAs(convFileNameTemp2, swSaveAsCurrentVersion, swSaveAsOptions_Silent + swSaveAsOptions_UpdateInactiveViews, swPDFExport, errors, warnings)
                    ' Save failed?
                    If Success = False Then Msgbox"Save Fail 3"
            End If
        Else
            Log "Document '" & docFileName & "' didn't contain any sheets named '[NamedSheet]'."
        End If
     ElseIf (True = Is3dPDF) Then 
     #If ("<Supported_2017SW>") Then
        Dim swMBDPdfData As SldWorks.MBD3DPdfData
        Dim ThemeName As String
        Dim ViewsChecks As Long
        Dim PrimaryViews As Long
        
        If (swDocPART = docType) Then
            ThemeName = "[Part3DPDFThemePath]"
            ViewsChecks = [PartThemeAndViewsChecks]
            PrimaryViews = [PartPrimaryViews]
        ElseIf (swDocASSEMBLY = docType) Then
            ThemeName = "[Asm3DPDFThemePath]"
            ViewsChecks = [AsmThemeAndViewsChecks]
            PrimaryViews = [AsmPrimaryViews]
        End If
        
        Set swMBDPdfData = swExtension.GetMBD3DPdfData
        Set swConfMgr = swModel.ConfigurationManager
        Dim vConfName As Variant
        Dim convFilePathTemp As Variant

        vConfName = swConfMgr.ActiveConfiguration.Name

        If Not IsEmpty(vConfName) Then
            convFilePathTemp = GetFullFileName(convFileName, vConfName, 0, 0)
        Else
            convFilePathTemp = convFileName
 End If

        'Set output path and file name for SOLIDWORKS MBD 3D PDF
        swMBDPdfData.FilePath = convFilePathTemp
        'Dont Display SOLIDWORKS MBD 3D PDF after creation
        swMBDPdfData.ViewPdfAfterSaving = False
        'Set SOLIDWORKS MBD 3D PDF theme path
        swMBDPdfData.ThemeName = ThemeName
        
        ' IF Primary views selected
        If (ViewsChecks And 2) Then
            Dim standardViews As Variant
            Dim viewIDs(9) As Long
            Dim index As Integer
            index = 0
            'Set standard views for SOLIDWORKS MBD 3D PDF
            If (PrimaryViews And 4) Then
                viewIDs(index) = swStandardViews_e.swFrontView
                index = index + 1
            End If
            If (PrimaryViews And 8) Then
                viewIDs(index) = swStandardViews_e.swBackView
                index = index + 1
            End If
            If (PrimaryViews And 16) Then
                viewIDs(index) = swStandardViews_e.swTopView
                index = index + 1
            End If
            If (PrimaryViews And 32) Then
                viewIDs(index) = swStandardViews_e.swBottomView
                index = index + 1
            End If
            If (PrimaryViews And 64) Then
                viewIDs(index) = swStandardViews_e.swLeftView
                index = index + 1
            End If
            If (PrimaryViews And 128) Then
                viewIDs(index) = swStandardViews_e.swRightView
                index = index + 1
            End If
            If (PrimaryViews And 256) Then
                viewIDs(index) = swStandardViews_e.swIsometricView
                index = index + 1
            End If
            If (PrimaryViews And 512) Then
                viewIDs(index) = swStandardViews_e.swDimetricView
                index = index + 1
            End If
            If (PrimaryViews And 1024) Then
                viewIDs(index) = swStandardViews_e.swTrimetricView
            End If

            standardViews = viewIDs
            swMBDPdfData.SetStandardViews (standardViews)
        End If
            
        '3D views(CustomViews) selected?
        If (ViewsChecks And 4) Then
            Dim vViewNames As Variant
            Dim status As Long
            vViewNames = swExtension.Get3DViewNames
            
            'Create and set custom views for SOLIDWORKS MBD 3D PDF
            swMBDPdfData.SetMoreViews (vViewNames)
        End If 

        Dim TextAndCustomProperties As Variant
        TextAndCustomProperties = swMBDPdfData.GetTextAndCustomProperties
         
        'Create SOLIDWORKS MBD 3D PDF
        status = swExtension.PublishTo3DPDF(swMBDPdfData)
          
        If bSecondOutput = True Then
                If Not IsEmpty(vConfName) Then
                    convFilePathTemp = GetFullFileName(convFileName2, vConfName, 0, 0)
                Else
                    convFilePathTemp = convFileName2
                End If

                swMBDPdfData.FilePath = convFilePathTemp
                ' if primary saved successfully then Second Output 3DPDF
                If status = swPublishTo3DPDF_Success Then      
                    status = swExtension.PublishTo3DPDF(swMBDPdfData)
                End If
        End If
                        
        ' Save failed?
        If status = swPublishTo3DPDF_InvalidPath Then
            Log "3D PDF - Invalid path."
        ElseIf status = swPublishTo3DPDF_InvalidTheme Then
            Log "Couldn’t access Theme file"
        ElseIf status = swPublishTo3DPDF_MBDLicenseNotAvailable Then
            Log "Failed to load SOLIDWORKS MBD. Verify that SOLIDWORKS MBD is installed and necessary license is available."
        ElseIf status = swPublishTo3DPDF_UnknownError Then
            Log "3D PDF - Unknown error."
        ElseIf status = swPublishTo3DPDF_NothingToPublish Then
            Log "The source file '" & docFileName & "' does not contain any view(s) to publish."
        End If
      #Else
        Log "Unsupported SOLIDWORKS version found on the task host "
      #End If
    Else
        Dim vConfNames As Variant
        Set swConfMgr = swModel.ConfigurationManager
        
        ' All configurations?
        If ([OutputConfs] And 2) = 2 Then
            vConfNames = swModel.GetConfigurationNames
        ' Last active conf?
        ElseIf ([OutputConfs] And 4) = 4 Then
            ReDim vConfNames(0 to 0) As Variant
            vConfNames(0) = swConfMgr.ActiveConfiguration.Name
        ' Named confs
        ElseIf ([OutputConfs] And 8) = 8 Then
            Dim vConfNamesTemp As Variant
            vConfNamesTemp = swModel.GetConfigurationNames
            removed = 0
            
            For i = 0 To UBound(vConfNamesTemp)
                vConfNamesTemp(i-removed) = vConfNamesTemp(i)
                confName = vConfNamesTemp(i)
                
                If Not confName Like "[NamedConf]" Then
                    removed = removed + 1
                EndIf
            Next i
            
            If (UBound(vConfNamesTemp) - removed) >= 0 Then
                ReDim Preserve vConfNamesTemp(0 To (UBound(vConfNamesTemp) - removed))
                vConfNames = vConfNamesTemp
            End If
        End If
        
        If Not IsEmpty(vConfNames) Then
            If ([FileConfs] And 4) = 4 Then
                ' Save configurations
                For i = 0 To UBound(vConfNames)
                    swModel.ShowConfiguration vConfNames(i)

                    convFileNameTemp = GetFullFileName(convFileName, vConfNames(i), i, UBound(vConfNames))
                    DoSave convFileNameTemp, docFileName, docType, ext, vConfNames(i)
                    
                    If bSecondOutput = True Then
                        convFileNameTemp2 = GetFullFileName(convFileName2, vConfNames(i), i, UBound(vConfNames))
                        DoSave convFileNameTemp2, docFileName, docType, ext, vConfNames(i)
                    End If
                Next i
            ElseIf ([FileConfs] And 2) = 2 Then
                If LCase(ext) = ".eprt" Or LCase(ext) = ".easm" Then
                    If ([OutputConfs] And 2) = 2 Then ' All confs?
                        swApp.SetUserPreferenceIntegerValue swEdrawingsSaveAsSelectionOption, swEdrawingSaveAll
                    ElseIf ([OutputConfs] And 4) = 4 Then ' Last active conf?
                        swApp.SetUserPreferenceIntegerValue swEdrawingsSaveAsSelectionOption, swEdrawingSaveActive  
                    ElseIf ([OutputConfs] And 8) = 8 Then ' Named confs
                        swApp.SetUserPreferenceIntegerValue swEdrawingsSaveAsSelectionOption, swEdrawingSaveSelected
                        selectedConfs = Join(vConfNames, vbLf)
                        swApp.SetUserPreferenceStringListValue swEmodelSelectionList, Trim(selectedConfs)
                    End If
                End If
                
                convFileNameTemp = GetFullFileName(convFileName, "All", 0, 0)
                DoSave convFileNameTemp, docFileName, docType, ext, "All"
                
                If bSecondOutput = True Then
                    convFileNameTemp2 = GetFullFileName(convFileName2, "All", 0, 0)
                    DoSave convFileNameTemp2, docFileName, docType, ext, "All"
                End If
            End If
        Else
            Log "Document '" & docFileName & "' didn't contain any configurations named '[NamedConf]'."
        End If
    End If

    ' Process virtual components
    If docType = swDocASSEMBLY Then
        Dim vComponents As Variant
        Set swAssembly = swModel
        
        vComponents = swAssembly.GetComponents(True)
        
        If Not IsEmpty(vComponents) Then
          For i = 0 To UBound(vComponents)
              Dim swComponent As SldWorks.Component2
              Set swComponent = vComponents(i)
              
              If swComponent.IsVirtual Then
                  Convert swComponent.GetPathName()
              End If
          Next i
      End If
    End If

    RestoreConversionOptions ext
    ' Close document
    swApp.QuitDoc swModel.GetTitle
End Sub

Function DoSave(convFilePath, docFileName, docType, ext, config)
    If LCase(ext) = ".dwg" Or LCase(ext) = ".dxf" Then
        If docType = swDocPART Then 'sheet-metal
            #If ("<Supported_2018SW>") Then
                Dim dataAlignment(11) As Double
                Dim varAlignment As Variant
Dim MultiBodyExport As Boolean
MultiBodyExport = [SheetMetalExportAs]
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

 Set swPart = swModel
 Dim featureMgr As SldWorks.FeatureManager
   Dim flatPatternFolder As SldWorks.flatPatternFolder
  Dim feat As SldWorks.Feature
  Dim featArray As Variant
 Dim i As Long

 Set swPart = swModel
  Set featureMgr = swPart.FeatureManager
 Set swExtension = swPart.Extension
 Set flatPatternFolder = featureMgr.GetFlatPatternFolder
 If Not (flatPatternFolder Is Nothing) Then
 featArray = flatPatternFolder.GetFlatPatterns
 If IsArray(featArray) Then
 For i = LBound(featArray) To UBound(featArray)
  Set feat = featArray(i)
  Success = swExtension.SelectByID2(feat.Name, "BODYFEATURE", 0, 0, 0, True, 0, Nothing, 0)
   Next i
 End If
 End If
 Options = [SheetMetalOptions]
Success = swPart.ExportToDWG2(convFilePath, docFileName, swExportToDWG_ExportSheetMetal, Not(MultiBodyExport), varAlignment, False, False, Options, Null)
  If Success = False Then
 If config = "All" Then
 Log "The file '" & docFileName & "' and configuration '" & config & "' can't be converted to the file extension '" & ext & "'."
    Else
 Log "The file '" & docFileName & "' can't be converted to the file extension '" & ext & "'."
  End If
End If
  #Else
 Log "Unsupported version ( SOLIDWORKS 2017 or earlier) is found on the task host"
   #End If
 Else 
     Log "Unsupported SOLIDWORKS file extension "
 End If
    Else

    ' Convert the document
    Success = swExtension.SaveAs(convFilePath, swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, errors, warnings)
    'restore original values
' Save failed?
If Success = False Then
 If config = "All" Then
 If errors = swerr_InvalidFileExtension Then
    Log "The file '" & docFileName & "' and configuration '" & config & "' can't be converted to the file extension '" & ext & "'."
 Else
Log "Method call ModelDocExtension::SaveAs for document '" & docFileName & "' and configuration '" & config & "' failed. Error code " & errors & " returned."
  If (((errors And swerr_SaveAsNotSupported) <> 0) And ((warnings And swwarn_MissingOLEObjects) <> 0)) Then
  Log "This document contains OLE objects. Such objects can't be converted outside of SolidWorks. Please open the document and perform the conversion from SolidWorks."
 End If 
 End If
 Else
  Log "Method call ModelDocExtension::SaveAs for document '" & docFileName & "' failed. Error code " & errors & " returned."
        End If
    End If
End If

DoSave = Success
End Function

Function bIsSupportedExtension(oExtension) As Boolean
    
    oExtension = LCase( oExtension )
    
    If oExtension = "prt" Then
       bIsSupportedExtension = True
    ElseIf oExtension = "asm" Then
       bIsSupportedExtension = True
    ElseIf oExtension = "drw" Then
       bIsSupportedExtension = True
    ElseIf oExtension = "sldlfp" Then
       bIsSupportedExtension = True
    ElseIf oExtension = "prtdot" Then
       bIsSupportedExtension = True
    ElseIf oExtension = "asmdot" Then
       bIsSupportedExtension = True
    ElseIf oExtension = "drwdot" Then
       bIsSupportedExtension = True
    Else
        bIsSupportedExtension = False
    End If
       
End Function

'-- -Stack Overflow REF

Sub main()
    bNeedRestore = false
    On Error GoTo Fail:

    Set FileSystemObj = CreateObject("Scripting.FileSystemObject")
    docFileName =  Function FileInfo(DwgName, FileLoc)

    If Left(DwgName, 3) = "574" Then
        FileLoc = "J:\1EngDocs\Drawings\5 MOTORS"
    Else
    FirstDigit = Left(DwgName, 1)
    Select Case FirstDigit
        Case Is = 0
            FileLoc = "J:\1EngDocs\Drawings\0 CUSTOMER INFO"
        Case Is = 1
            FileLoc = "J:\1EngDocs\Drawings\1 COMPLETE FAN"
        Case Is = 2
            FileLoc = "J:\1EngDocs\Drawings\2 INLET-OUTLET"
        Case Is = 3
            FileLoc = "J:\1EngDocs\Drawings\3 HOUSING"
        Case Is = 4
            FileLoc = "J:\1EngDocs\Drawings\4 WHEEL"
        Case Is = 5
            FileLoc = "J:\1EngDocs\Drawings\5 DRIVE TRAIN"
        Case Is = 6
            FileLoc = "J:\1EngDocs\Drawings\6 ACCESSORIES"
        Case Is = 7
            FileLoc = "J:\1EngDocs\Drawings\7 BASE"
        Case Is = 8
            FileLoc = "J:\1EngDocs\Drawings\8 HARDWARE"
        Case Is = 9
            FileLoc = "J:\1EngDocs\Drawings\9 MATERIAL"
    End Select
    End If
    
    ' Get SW interface object
    Set swApp = Application.SldWorks
    swApp.Visible = True 
    Convert docFileName
    
    Exit Sub
'--


       
Fail:
    Log "Error while converting file '" & docFileName & "': " & vbCrLf & _
        "An unexpected error occurred while executing the generated script. Script syntax error?" & vbCrLf & _
        "Error number: " & Err.Number & vbCrLf & _
        "Error description: '" & Err.Description & "'" & vbCrLf
End Sub

1

There are 1 best solutions below

3
bigcrazyal On

In the PDM Administration tool, select the Convert to PDF Task properties window. On the "output file details" tab, there is an "Advanced Scripting Options" button. If you open that, it shows all of the code that runs to complete the task.

In the main method, it accepts an argument from the GUI for the save path as "<Filepath>" and stores it in docFileName so all you have to do is set docFileName to whatever you want instead of this default value.

Sub main()
   bNeedRestore = false
   On Error GoTo Fail:

   Set FileSystemObj = CreateObject("Scripting.FileSystemObject")
   docFileName = "<Filepath>" ' OVERRIDE THIS VALUE WITH YOUR PATH

   ' Get SW interface object
   Set swApp = Application.SldWorks
   swApp.Visible = True 
   Convert docFileName

Exit Sub