2025年11月2日

SolidWorksでフォルダ内のデータを一括STEP変換するマクロ公開！

SolidWorksで複数のパーツやアセンブリをSTEP形式にまとめて出力したい場面、ありますよね。
手作業で「開いて → 保存して → 閉じる」を繰り返すのは、時間泥棒もいいところ。

マクロの概要

項目	内容
対象ファイル	`.SLDPRT` / `.SLDASM`
出力形式	`.STEP`（同一フォルダに保存）
動作環境	SolidWorks 2020以降
付加機能	展開状態を自動解除してから保存
作成者	sokaitechnology（国井彰吾）

マクロコード全文

以下のコードをVBAマクロ（拡張子 .swp）として保存し、
SolidWorksのメニューから「ツール → マクロ → 実行」で呼び出してください。
フォルダを選択すると、その中のファイルを自動的にSTEP変換します。

' =============================================
' SolidWorks 一括STEP変換マクロ
' 作成者：sokaitechnology（国井 彰吾）
' 更新日：2025/11/02
' =============================================

Option Explicit

' SLDPRT/SLDASM を 同フォルダ に .STEP で一括出力
' 追加要件: シートメタルが展開(Flat-Pattern)状態なら抑制して折り曲げ状態に戻してから書き出し
Sub Export_Parts_And_Assemblies_To_STEP_FoldFirst()
    On Error GoTo EH

    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim folderPath As String
    Dim exportPath As String
    Dim errors As Long, warnings As Long
    Dim i As Long, n As Long
    Dim ok As Boolean

    Set swApp = Application.SldWorks

    ' --- フォルダ選択 ---
    Dim sh As Object, f As Object
    Set sh = CreateObject("Shell.Application")
    Set f = sh.BrowseForFolder(0, "STEPに変換したいフォルダを選択（サブフォルダ未対応）", &H1, 0)
    If f Is Nothing Then
        MsgBox "キャンセルされました。", vbInformation
        Exit Sub
    End If
    folderPath = f.Self.Path
    If Right$(folderPath, 1) <> "\" Then folderPath = folderPath & "\"

    ' --- ① 対象ファイルを事前収集 ---
    Dim fso As Object, fol As Object, fil As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fol = fso.GetFolder(folderPath)

    Dim targets() As String
    ReDim targets(0 To 0)
    n = 0

    For Each fil In fol.Files
        Dim ext As String
        ext = LCase$(fso.GetExtensionName(fil.Name))
        If ext = "sldprt" Or ext = "sldasm" Then
            If n > UBound(targets) Then ReDim Preserve targets(0 To n)
            targets(n) = fil.Path
            n = n + 1
        End If
    Next fil

    If n = 0 Then
        MsgBox "このフォルダに SLDPRT / SLDASM は見つかりませんでした。", vbExclamation
        Exit Sub
    End If

    ' --- ② 収集済みリストを順次処理 ---
    Dim processed As Long, failed As Long
    For i = 0 To n - 1
        Dim fullpath As String, filename As String, extLower As String
        Dim docType As Long, pos As Long

        fullpath = targets(i)
        filename = fso.GetFileName(fullpath)
        extLower = LCase$(fso.GetExtensionName(fullpath))

        docType = IIf(extLower = "sldprt", 1, 2) ' 1: swDocPART, 2: swDocASSEMBLY

        ' 開く（サイレント）
        errors = 0: warnings = 0
        Set swModel = swApp.OpenDoc6(fullpath, docType, 64, "", errors, warnings) ' 64: swOpenDocOptions_Silent

        If Not swModel Is Nothing Then
            ' ====== 追加：シートメタルの展開を解除（＝Flat-Patternを抑制） ======
            If docType = 1 Then Call EnsureFolded_SuppressFlatPattern(swModel)

            ' 出力先パス（拡張子切り落として .STEP 付与）
            pos = InStrRev(filename, ".")
            If pos > 0 Then
                exportPath = folderPath & Left$(filename, pos - 1) & ".STEP"
            Else
                exportPath = folderPath & filename & ".STEP"
            End If

            ' 必要最小限アクティブ化
            swApp.ActivateDoc3 filename, False, 0, errors

            ' 保存（ダイアログ抑止: swSaveAsOptions_Silent=1）
            errors = 0: warnings = 0
            ok = swModel.Extension.SaveAs(exportPath, 0, 1, Nothing, errors, warnings)

            ' クローズ
            swApp.CloseDoc filename

            If ok And Len(Dir$(exportPath)) > 0 Then
                Debug.Print "OK: " & exportPath
                processed = processed + 1
            Else
                Debug.Print "NG: " & fullpath & "  errors=" & errors & " warnings=" & warnings
                failed = failed + 1
            End If
        Else
            Debug.Print "開けず: " & fullpath & "  errors=" & errors & " warnings=" & warnings
            failed = failed + 1
        End If

        DoEvents
    Next i

    MsgBox "完了: " & processed & " 件 / 失敗: " & failed & " 件" & vbCrLf & _
           "出力先: " & folderPath, vbInformation
    Exit Sub

EH:
    MsgBox "エラー発生: " & Err.Number & vbCrLf & Err.Description, vbExclamation
End Sub

' ▼ シートメタルの Flat-Pattern を見つけたら「抑制」して折り曲げ状態へ戻す
Private Sub EnsureFolded_SuppressFlatPattern(ByVal swModel As SldWorks.ModelDoc2)
    On Error Resume Next

    Dim feat As SldWorks.Feature
    Set feat = swModel.FirstFeature

    Do While Not feat Is Nothing
        ' GetTypeName2 = "FlatPattern" がフラットパターン（ローカライズに影響されない）
        If LCase$(feat.GetTypeName2) = "flatpattern" Then
            If Not feat.IsSuppressed Then
                swModel.ClearSelection2 True
                feat.Select2 False, 0
                ' 現在の構成で抑制（＝展開を解除）
                swModel.EditSuppress2
                swModel.ClearSelection2 True
            End If
            Exit Do ' 見つけたら十分
        End If
        Set feat = feat.GetNextFeature
    Loop
End Sub

使い方

SolidWorksを起動
「ツール → マクロ → 実行」を選択
上記マクロファイル（.swp）を選択
対象フォルダを指定して実行

完了すると、「STEP変換が完了しました！」と表示され、
元のフォルダ内に .STEP ファイルが生成されます。

注意点と改善ポイント

大型アセンブリを大量に処理するとメモリ負荷が高くなるため、分割実行推奨。
日本語ファイル名を含む場合、一部環境でエラーが出ることがあります。

効果とまとめ

このマクロを使えば、手作業で1件ずつ保存していた作業を1クリックで完結できます。
100ファイルの変換が5分で終わるので、実質1時間以上の時短効果。

自動化は、日々の「ちょっと面倒」をなくす積み重ね。
SolidWorksユーザーの方は、ぜひ試してみてください。

この記事を書いた人

国井彰吾（sokaitechnology）
福島県いわき市で、板金・治具・特注設備の3D設計を行っています。
現場目線で「作りやすさ」「安全」「納期」を両立する設計を支援しています。
SolidWorksを使った自動化・マクロ開発もお任せください。
📧 shogo_kunii@sokaitech.com

blog