ようこそ！今回は、CADエンジニアなら誰もが一度は頭を抱えたことがある「他社CADからエクスポートされたSTEPファイルを開いたら、数千個の部品が同一階層にズラリと並んでいて絶望した……」という問題を、SolidWorks VBAでエレガントに解決していきましょう。
「マクロの記録」から一歩踏み出し、SolidWorks APIの「本当の力」を引き出せるようになると、こうした何時間もかかる手作業のツリー整理が、わずか数秒のスクリプト実行で終わるようになります。
少し高度な内容に感じるかもしれませんが、大丈夫。基礎から本質まで、一緒にステップバイステップで紐解いていきましょう！
—
1. なぜ「フラットなSTEPツリー」は悪夢なのか？
まずは、私たちが直面している課題を図解で整理してみましょう。
【インポート直後の地獄（フラット構造）】
RootAssembly.SLDASM
├── UNIT-A_Plate-1
├── UNIT-A_Bolt-1
├── UNIT-A_Bolt-2
├── UNIT-B_Bracket-1
├── UNIT-B_Motor-1
└── … (数千部品が延々と続く)
↓↓↓【理想の階層構造】↓↓↓
RootAssembly.SLDASM
├── UNIT-A.SLDASM （自動生成されたサブアセンブリ）
│ ├── Plate-1
│ ├── Bolt-1
│ └── Bolt-2
└── UNIT-B.SLDASM （自動生成されたサブアセンブリ）
├── Bracket-1
└── Motor-1
STEPファイルは、エクスポート元のCADや中間フォーマットの仕様によって、せっかくのアセンブリ構造（ツリー階層）が消滅し、最上位アセンブリの直下に全パーツがフラットに展開されてしまうことが多々あります。
この状態の何が危険かというと：
- 表示・再構築パフォーマンスの低下（SolidWorksは適切な階層構造がある方がグラフィックの最適化が効きます）
- 図面化・BOM作成の破綻（ユニットごとの部品表が作れない）
- 合致（Mate）の管理が不可能（ツリーが長すぎて目的の部品を探せない）
これを手作業で「右クリック ＞ 新しいサブアセンブリをここで形成」と繰り返すのは、エンジニアの貴重な時間の浪費ですよね。プログラミングの力で一気に自動化してしまいましょう。
—
2. 実装のキモ：命名規則のパースとサブアセンブリの自動形成
今回の自動化ロジックの骨子は以下の通りです。
1. 最上位アセンブリ内の全コンポーネントの名前を走査する
2. プレフィックス（接頭辞、例: `UNIT-A_`）を抽出してグループ化する
3. 対象となる部品群をSolidWorksの選択マネージャ（SelectionMgr）に積む
4. SolidWorks APIの `AssemblyDoc::FormNewSubassembly` を呼び出し、一括でサブアセンブリ化する
5. 複数階層（多重の区切り文字）にも対応できるよう、構造を解析して処理する
覚えておきたいAPIの基本オブジェクト
- `ModelDoc2`: ドキュメント（アセンブリ）そのもの
- `AssemblyDoc`: アセンブリ特有の機能を扱うインターフェース
- `Component2`: ツリーにぶら下がる個々の部品・アセンブリ参照
- `SelectionMgr`: SolidWorksの「青くハイライト選択されている状態」を操作するマネージャ
—
3. 実践コード：プレフィックス解析＆階層化マクロ
以下のコードを、SolidWorksのVBAエディタ（Alt + F11）に貼り付けてみてください。
まずはテスト用のダミーアセンブリで試してみることをおすすめします。
Option Explicit
‘ =========================================================================
‘ 処理名: STEPインポート後のフラットアセンブリ自動階層化マクロ
‘ 概要 : 部品名の接頭辞（区切り文字 “_”）を解析し、サブアセンブリを自動形成します
‘ =========================================================================
Public Sub AutoStructureAssembly()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swAssy As SldWorks.AssemblyDoc
Dim swSelMgr As SldWorks.SelectionMgr
‘ SolidWorksアプリケーションおよびアクティブモデルの取得
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
‘ ガード節: アセンブリが開かれているかチェック
If swModel Is Nothing Then
MsgBox “アセンブリを開いた状態で実行してください。”, vbExclamation, “エラー”
Exit Sub
End If
If swModel.GetType <> swDocASSEMBLY Then
MsgBox “このマクロはアセンブリドキュメント専用です。”, vbExclamation, “エラー”
Exit Sub
End If
Set swAssy = swModel
Set swSelMgr = swModel.SelectionManager
‘ 画面描画のフリーズ（パフォーマンス向上の鉄則）
swModel.FeatureManager.EnableFeatureTree = False
On Error GoTo ErrorHandler
‘ 最上位コンポーネントを走査してグループ化マップを生成
Dim compDict As Object
Set compDict = CreateObject(“Scripting.Dictionary”)
Dim vComps As Variant
‘ TopLevelOnly = True で、最上位の直下にあるコンポーネントのみを取得
vComps = swAssy.GetComponents(True)
If IsEmpty(vComps) Then
MsgBox “整理対象のコンポーネントが存在しません。”, vbInformation, “終了”
GoTo Finalize
End If
Dim i As Long
Dim swComp As SldWorks.Component2
Dim compName As String
Dim groupKey As String
Dim delimiterPos As Long
‘ 1. 名前を解析してDictionaryに分類格納
For i = 0 To UBound(vComps)
Set swComp = vComps(i)
‘ サプレッションされているパーツ等は除外
If swComp.GetSuppression = swComponentFullyResolved Then
compName = swComp.Name2
‘ 例: “UNIT-A_PART-01-1” から “UNIT-A” を抽出（区切り文字を “_” とする）
delimiterPos = InStr(compName, “_”)
If delimiterPos > 1 Then
groupKey = Left(compName, delimiterPos – 1)
‘ グループごとにコンポーネントの参照リストを構築
If Not compDict.Exists(groupKey) Then
compDict.Add groupKey, CreateObject(“System.Collections.ArrayList”)
End If
compDict(groupKey).Add swComp
End If
End If
Next i
‘ 2. 各グループを順番に選択し、サブアセンブリ化
Dim key As Variant
Dim compList As Object
Dim selData As SldWorks.SelectData
Set selData = swSelMgr.CreateSelectData
For Each key In compDict.Keys
Set compList = compDict(key)
‘ 1つのグループに2点以上ある場合のみサブアセンブリ化
If compList.Count > 1 Then
‘ 選択セットをクリア
swModel.ClearSelection2 True
‘ グループに属する全コンポーネントを選択状態にする
Dim j As Long
For j = 0 To compList.Count – 1
Dim targetComp As SldWorks.Component2
Set targetComp = compList.Item(j)
‘ 第2引数をTrueにして追加選択（Append）していく
targetComp.Select4 True, selData, False
Next j
‘ APIによる「新しいサブアセンブリをここで形成」の実行
‘ 引数: サブアセンブリを仮想コンポーネントとして形成するか、ファイル保存するか
‘ ここでは扱いやすいように内部（仮想）アセンブリとして形成
Dim status As Long
status = swAssy.FormNewSubassembly
If status <> 0 Then
Debug.Print “サブアセンブリ形成失敗: ” & key & ” (ステータス: ” & status & “)”
Else
Debug.Print “サブアセンブリ形成成功: ” & key
End If
End If
Next key
MsgBox “アセンブリの自動整理が完了しました！”, vbInformation, “完了”
Finalize:
‘ 画面描画の再有効化
swModel.FeatureManager.EnableFeatureTree = True
swModel.ForceRebuild3 True
Exit Sub
ErrorHandler:
MsgBox “予期せぬエラーが発生しました: ” & Err.Description, vbCritical, “エラー”
Resume Finalize
End Sub
—
4. プロの設計思想：ここをクリアすればVBAの基本はバッチリ！
コードをただ眺めるだけでなく、なぜこのような書き方をしているのか「プロのツボ」を3つ解説します。
① `swAssy.GetComponents(True)` の引数の意味
`GetComponents` メソッドの第1引数に `True` を渡すと、「最上位階層のコンポーネントのみ」を取得します。`False` を渡すと全階層の孫コンポーネントまで平坦に全取得してしまいます。今回は「ルートに散らばっている部品をまとめる」のが目的なので、必ず `True` を使います。
② Scripting.Dictionary ＋ ArrayList のコンビネーション
初学者がつまずきやすいのが、「可変個数のグループ」をどう配列で管理するかです。
VBA標準の動的配列（`ReDim Preserve`）は動作が重く、コードも煩雑になりがちです。
- キー（グループ名）の管理には `Scripting.Dictionary`
- 可変長のコンポーネントリストには `.NETの ArrayList`
この黄金ペアを使うことで、グルーピング処理が非常にシンプルかつ高速になります。
③ 画面描画の抑制（`EnableFeatureTree`）
数百・数千のコンポーネントをループで選択・変更する際、フィーチャーツリーが毎回再描画されると、処理時間が何十倍にも膨れ上がります。
`swModel.FeatureManager.EnableFeatureTree = False` で一時的にツリー描画を止め、最後に `True` に戻す。これだけでマクロの体感速度は劇的に向上します。
—
5. 現場で陥りやすい落とし穴と回避策
罠1：サブアセンブリ化したあとに「座標（位置）」が狂う？
`FormNewSubassembly` APIの素晴らしいところは、GUI操作の「新しいサブアセンブリをここで形成」と全く同じ挙動をする点です。
パーツのグローバル座標系での配置状態を維持したまま、新しいサブアセンブリの原点との相対関係（Transformマトリクス）をSolidWorksが内部で自動計算して合致や固定関係を保持してくれます。
自前で新規アセンブリを作ってパーツを切り貼り（Cut & Paste）しようとすると、座標計算で確実に地獄を見ることになるため、必ずこのAPIを活用しましょう。
罠2：パーツ名に区切り文字が含まれていない場合
実務では、すべてのファイルが命名規則に沿っているとは限りません。
`delimiterPos = InStr(compName, “_”)` の部分を、現場のルールに合わせてカスタマイズしてください。
- 正規表現（`VBScript.RegExp`）を用いて正規の型番パターンのみを抽出する
- 連番の先頭4文字をキーにする（`Left(compName, 4)`）
など、柔軟にロジックを切り替えられるようにしておくと盤石です。
—
まとめ：マクロを活用して「クリエイティブな設計」に時間を使おう
今回は、インポートされたフラットなSTEPアセンブリを、命名規則に基づいて自動でサブアセンブリ階層へとリファクタリングする手法を紹介しました。
1. ツリーの平坦化は設計効率とパフォーマンスの大敵
2. `Dictionary` と `ArrayList` でスマートにグルーピング
3. `FormNewSubassembly` を使えば、座標系を壊さずに階層化できる
この3つのポイントを理解できれば、SolidWorks VBAを使ったアセンブリ操作の基本はバッチリです！
手作業でやれば1時間かかる不毛なツリー整理も、マクロなら一瞬。浮いた時間で、より良い設計案を練ったり、新しい技術を学んだりしてくださいね。応援しています！
