SOLIDWORKSで指定保存の自動化 PDF化

大量の図面のPDF化があって困った

そんなときはマクロの出番です

SOLIDWORKSでPDFに指定保存するときってプルダウンから選ぶのですが、沢山あるから見つけるのが大変 出図の時は枚数が多いからストレスが溜まります

そこで、自動化を試みました

まずは、マクロの記録から

Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long


Sub main()
    Set swApp = Application.SldWorks
    Set Part = swApp.ActiveDoc
    
    longstatus = Part.SaveAs3("C:\*********.pdf", 0, 2)
End Sub

このように記録されました

このままでは毎回決められたファイル名になってしまうので、

開いているファイル名を使用できないか考えます

まずは、ファイルのパスとファイル名を取得します

次に、拡張子を取り除いて、そこにPDFという拡張子を入れます

こうしてできたのがこちらになります

Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Sub main()
    Dim filePathName
    Dim ffname
    Dim ext
    
    Set swApp = Application.SldWorks
    Set Part = swApp.ActiveDoc
    
    filePathName = Part.GetPathName
    
    If filePathName = "" Then
        MsgBox "ファイル名を付けて保存をしてから実行して下さい。", vbCritical
        End
    End If
    
    ffname = Left(filePathName, InStrRev(filePathName, ".") - 1)
    ext = ".pdf"
    filePathName = ffname & ext
    
    longstatus = Part.SaveAs3(filePathName, 0, 2)
End Sub

これで、SOLIDWORKSのファイルのあるフォルダに同じファイル名でPDFを作ることができました

日付けを追加して履歴の管理をしたい場合は

Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long


Sub main()
    Dim filePathName
    Dim ffname
    Dim ext
    
    Set swApp = Application.SldWorks
    Set Part = swApp.ActiveDoc
    
    filePathName = Part.GetPathName
    
    If filePathName = "" Then
        MsgBox "ファイル名を付けて保存をしてから実行して下さい。", vbCritical
        End
    End If
    
    ffname = Left(filePathName, InStrRev(filePathName, ".") - 1)
    ext = ".pdf"
    filePathName = ffname & "_" & Format(Now(), "yyyymmdd") & ext
    
    longstatus = Part.SaveAs3(filePathName, 0, 2)
End Sub

Format関数を使用していますので、表示形式は好みで変更できます。 yyyymmdd　を　yyyy-mm-dd　とかに変更できます 時間も追加したい場合は　yyyymmdd-mmss　みたいにするとできます