SolidWorks関連のAPIについて（SolidWorks API マクロコード編）

概要

SolidWorks API概要編に続いて、実際に使えるマクロの例を記載する。

①ファイルを開く

Function OpenSldFile(ByVal filePath As String) As SldWorks.ModelDoc2
    Dim swObject As SldWorks.ModelDoc2
    Dim ext As String
    Dim typeL As Long
    Dim fso As Object
    Dim errors As Long
    Dim warnings As Long

    Set fso = CreateObject("Scripting.FileSystemObject")
    ext = LCase(fso.GetExtensionName(filePath))
    
    Select Case ext
        Case FILE_EXT_SLDPRT
            typeL = swDocPART '1
    
        Case FILE_EXT_SLDASM
            typeL = swDocASSEMBLY '2
    
        Case FILE_EXT_SLDDRW
            typeL = swDocDRAWING '3
    
        Case Else
            typeL = 0
    End Select
    
    If typeL <> 0 Then
        ' ファイル拡張子に応じてファイルを開く
        ' 第1引数：開きたいファイルのフルパス
        ' 第2引数：ファイルの種類（部品、アセンブリ、図面）
        ' 第3引数：開き方のオプション
        '           ・swOpenDocOptions_Silent：メッセージを出さずに静かに開く
        '           ・swOpenDocOptions_ReadOnly：読み取り専用で開く
        '           ・swOpenDocOptions_LoadModel：通常通りロードして開く（モデルをメモリに展開）
        '           ・swOpenDocOptions_Lightweight：軽量モードで開く（アセンブリ時など）
        '           ・swOpenDocOptions_DontLoadHiddenParts：非表示の部品をロードしない
        ' 第4引数：特定の構成名を開く場合に指定
        ' 第5引数：エラーコード
        ' 第6引数：警告コード
        Set swObject = swApp.OpenDoc6(filePath, typeL, swOpenDocOptions_Silent Or swOpenDocOptions_ReadOnly, "", errors, warnings)
        
        If swObject Is Nothing Then
            Call MsgBox("エラーメッセージ", vbOKOnly + vbExclamation, "エラー")
            Exit Function
        End If
    Else
        Call MsgBox("エラーメッセージ", vbOKOnly + vbExclamation, "エラー")
        Exit Function
    End If
    
    Set OpenSldFile = swObject
End Function

②ファイルを閉じる

Sub CloseFile(ByVal swModel As SldWorks.ModelDoc2)
    If Not swModel Is Nothing Then
        Dim title As String
    
        On Error Resume Next
        title = swModel.GetTitle
        On Error GoTo 0
    
        If Len(title) = 0 Then
            Exit Sub
        End If
        
        swApp.CloseDoc title
    End If
End Sub

③変数の値を読み取る（例として図面のRevisionを読み取る）

Function GetDrawingRevision(ByVal swDraw As SldWorks.DrawingDoc) As String
    Dim swModel As SldWorks.ModelDoc2
    Dim val As String
    Dim resolved As String

    Set swModel = swDraw

    ' "Revision" が存在しているかどうかチェック
    val = swModel.GetCustomInfoValue("", "Revision")

    If val = "" Then
        GetDrawingRevision = ""
        Exit Function
    End If

    resolved = swModel.GetCustomInfoValue2("", "Revision")

    GetDrawingRevision = resolved
End Function

④図面からモデルを検索する

Function GetCurrentModelFromDrawing(ByVal swDraw As SldWorks.DrawingDoc) As String
    Dim swModel As SldWorks.ModelDoc2
    Dim errors As Long
    Dim vRefs As Variant
    
    Set swModel = swDraw
    
    ' 図面をアクティブ化
    swApp.ActivateDoc2 swModel.GetTitle, False, errors

    '第1引数：依存ファイルをすべて再帰的にたどるかどうかを指定（Falseを指定して直接関連があるもののみにする）
    '第2引数：依存ファイルを探す際の検索方法を指定
    '第3引数：返される文字列の中に「読み取り専用情報（Read-only info）」を含めるか
    vRefs = swDraw.GetDependencies2(False, True, True)

    If IsEmpty(vRefs) Then
        GetCurrentModelFromDrawing = ""
        Exit Function
    End If

    ' 以下で0ではなく1にしているのは、偶数に名前、奇数にファイルパスが入っているから
    GetCurrentModelFromDrawing = vRefs(1)
End Function

④図面を開くのに必要なアセンブリやパートファイル一式を、指定したフォルダにコピーする

Sub GetReferencesFromDrawing2(ByVal swDraw As SldWorks.DrawingDoc, ByVal folderPath As String)
    Dim swModel As SldWorks.ModelDoc2
    Dim swExt As SldWorks.ModelDocExtension
    Dim swPack As SldWorks.PackAndGo
    
    Dim status As Boolean
    Dim pgNames As Variant
    Dim statuses As Variant
    
    Set swModel = swDraw
    Set swExt = swModel.Extension
    Set swPack = swModel.Extension.GetPackAndGo
    
    ' オプション設定
    swPack.IncludeDrawings = True           ' 図面も含む
    swPack.IncludeSuppressed = True         ' 抑制された部品も含む
    swPack.IncludeToolboxComponents = False ' Toolbox を除外すると軽量化可能
    swPack.FlattenToSingleFolder = True     ' 1フォルダにフラットにコピー

    ' 現在のファイル名一覧を取得
    status = swPack.GetDocumentNames(pgNames)
    ' いったんそのまま保存名としてセット
    status = swPack.SetDocumentSaveToNames(pgNames)
    
    ' 保存フォルダをまとめて上書き指定
    ' 第1引数: True = 既存の SaveToNames をこのパスで上書き
    ' 第2引数: 保存先フォルダ or ZIPファイルパス
    status = swPack.SetSaveToName(True, folderPath)

    ' Pack and Go 実行
    statuses = swExt.SavePackAndGo(swPack)
End Sub

⑤図面の全シートに透かし文字を入れる

Sub AddWatermarkToDrawing(ByVal swDraw As SldWorks.DrawingDoc, ByVal text As String)
    Dim swObject As SldWorks.ModelDoc2
    Dim swNote As SldWorks.Note
    Dim swAnn As SldWorks.Annotation
    Dim sheetWidth As Double, sheetHeight As Double
    Dim textFormat As String
    
    Dim vSheetNames As Variant
    Dim i As Long
        
    ' 図面内の全シート名を取得
    vSheetNames = swDraw.GetSheetNames
    
    ' 全シートを対象に処理する
    For i = LBound(vSheetNames) To UBound(vSheetNames)
    
        ' シートをアクティブにする
        Dim swSheet As SldWorks.Sheet
        swDraw.ActivateSheet vSheetNames(i)
        Set swSheet = swDraw.GetCurrentSheet
    
        ' シートサイズ取得
        swSheet.GetSize sheetWidth, sheetHeight
        
        ' 右下基準で位置を決める
        Const OFFSET_X_MM As Double = 80   ' 右端から左にXXmm
        Const OFFSET_Y_MM As Double = 70  ' 下端から上にXXmm
        
        ' 右下 = (sheetWidth, 0)
        ' そこから左へ OFFSET_X_MM, 上へ OFFSET_Y_MM
        Dim xPos As Double, yPos As Double
        xPos = sheetWidth - (OFFSET_X_MM / 1000#)
        yPos = (OFFSET_Y_MM / 1000#)
        
        ' 透かし文字追加
        Set swObject = swDraw
        textFormat = "<FONT color=0x00c2c3e9><FONT name=""Arial"" size=32PTS>" & text
        
        swDraw.EditTemplate
            
        Set swNote = swObject.InsertNote(textFormat)
        Set swAnn = swNote.GetAnnotation
        swAnn.SetPosition2 xPos, yPos, 0
    
        ' プロパティ設定
        swNote.Angle = 30 * (3.14159 / 180) ' 30度回転
        swNote.SetTextJustification swTextJustificationCenter ' 中央揃え
        swNote.BehindSheet = True ' 図面の場合はこれが重要で透過の意味を持つ
        
        swDraw.EditSheet
    Next i
End Sub

⑥図面をPDF形式で保存する

Sub OutputPDFFile(ByVal swDraw As SldWorks.DrawingDoc, ByVal filePath As String)
    Dim swModel As SldWorks.ModelDoc2
    Dim swExt As SldWorks.ModelDocExtension
    Dim pdfData As SldWorks.ExportPdfData
    Dim errors As Long
    Dim warnings As Long

    ' 各種PDF設定
    Set swExt = swDraw.Extension
    Set pdfData = swApp.GetExportFileData(swExportDataFileType_e.swExportPdfData)
    pdfData.ViewPdfAfterSaving = False ' 出力後に自動で開かない
    pdfData.ExportAs3D = False         ' 3D PDFを無効化（2D図面向け）
    pdfData.SetSheets swExportDataSheetsToExport_e.swExportData_ExportAllSheets, vSheetNames ' 全てのシートを対象にする
    
    swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swPDFExportHighQuality, True
    swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swPDFExportInColor, True ' カラーを有効化

    ' 保存する
    Call swExt.SaveAs(filePath, swSaveAsVersion_e.swSaveAsCurrentVersion, swSaveAsOptions_Silent, pdfData, errors, warnings)
End Sub

SolidWorksのAPIに関して各種対応可能です。お問い合わせはこちらまで↓