SolidWorks VBAを掌握する極限の知見
アセンブリ全構成部品の材質・質量特性一括取得とExcel品質レポート自動生成アーキテクチャ
著者：チーフシステムアーキテクト / 20年目のSolidWorks VBAマイスター
—
現場の設計者から「数千点規模のアセンブリにおいて、各パーツの材質変更に伴う重量配分の変動を瞬時にチェックし、公式フォーマットのExcel品質レポートとして出力したい」という要求を受けたとき、君はどうする？
手作業でプロパティを開き、材質を確認し、質量をメモしてExcelに転記する？そんな前時代的なアプローチは、我々のエンジニアリング辞書には存在しない。
今回は、SolidWorks APIの深い階層構造をハックし、メモリリークを完全に封じ込め、さらにExcelオートメーションのオーバヘッドを極限まで削ぎ落とした「実務直結型・重量配分チェックシート自動生成エンジン」の全貌を公開する。
—
1. アーキテクチャの要諦：なぜ通常のVBAコードでは破綻するのか？
大規模アセンブリをVBAで走査する際、開発者が直面する最大の罠は以下の3点だ。
1. COMオブジェクトのゾンビ化とメモリリーク
`SldWorks.ModelDoc2` や `Component2` を安易にループ内で取得・解放し損ねると、背後でSolidWorksのプロセスが肥大化し、最悪の場合VBEごとクラッシュする。
2. コンポーネントの「コンフィギュレーション」と「参照ファイル」の乖離
アセンブリに配置されているインスタンス（Component2）と、その実体であるドキュメント（ModelDoc2）は別物である。これを混同すると、正しい材質や質量特性が取得できない。
3. Excel連携時のI/Oボトルネック
セルへの書き込みを1件ずつ行うと、COM境界を跨ぐコストが蓄積し、処理が耐えがたいほど遅くなる。Variant配列を用いた一括転送（Bulk Transfer）が必須となる。
これらをクリアする唯一の解が、「再帰的コンポーネント走査 ＋ 厳格な参照カウンタ管理 ＋ Variant配列によるExcel高速バッチ出力」の組み合わせである。
—
2. 実装コード：一括取得・Excelレポート出力エンジン
以下のコードは、現在アクティブなアセンブリから全サブアセンブリ・パーツを再帰的に収集し、材質名、質量、重心位置、体積を抽出してExcelへ爆速出力するプロフェッショナルグレードのモジュールだ。
Option Explicit
‘ =========================================================================
‘ 業務直結型：アセンブリ質量・材質一括取得＆Excel品質レポート生成エンジン
‘ =========================================================================
Public Sub ExportAssemblyMassPropertiesToExcel()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swAssDoc As SldWorks.AssemblyDoc
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
‘ 1. アプリケーション状態の厳格な事前検証
If swModel Is Nothing Then
MsgBox “アクティブなドキュメントが存在しません。”, vbCritical, “致命的エラー”
Exit Sub
End If
If swModel.GetType() <> swDocASSEMBLY Then
MsgBox “対象ドキュメントはアセンブリではありません。”, vbCritical, “型不一致エラー”
Exit Sub
End If
Set swAssDoc = swModel
‘ 2. 処理速度向上のための画面描画・イベント抑制
swApp.UserControl = False
swApp.Visible = False ‘ 描画を隠蔽してスループットを最大化（必要に応じてTrueに）
swModel.SetSaveFlag
Dim startTime As Double
startTime = Timer
‘ 3. データ格納用動的配列の初期化 (最大推定サイズ: 10000行, 7列)
‘ 列構成: [0]階層パス, [1]コンポーネント名, [2]部品番号, [3]材質, [4]質量(kg), [5]体積(m^3), [6]重心Z(mm)
Dim reportData() As Variant
ReDim reportData(1 To 7, 1 To 1)
Dim dataCount As Long
dataCount = 0
‘ 4. アセンブリのトップレベルコンポーネント群を取得し再帰走査開始
Dim vComps As Variant
vComps = swAssDoc.GetComponents(True) ‘ TopLevelOnly = True
If Not IsEmpty(vComps) Then
Dim i As Long
For i = LBound(vComps) To UBound(vComps)
Dim swComp As SldWorks.Component2
Set swComp = vComps(i)
‘ 非表示部品や軽量部品のハンドリング
If Not swComp.IsSuppressed() Then
Call TraverseComponent(swComp, “”, dataCount, reportData)
End If
‘ オブジェクトの明示的解放
Set swComp = Nothing
Next i
End If
‘ 5. Excelアプリケーションへの出力処理
If dataCount > 0 Then
Call OutputToExcel(reportData, dataCount)
MsgBox “レポート出力完了。処理時間: ” & Format(Timer – startTime, “0.00”) & “秒”, vbInformation, “完了”
Else
MsgBox “有効なコンポーネントが見つかりませんでした。”, vbExclamation, “警告”
End If
‘ 6. クリーンアップとシステム復旧
swApp.Visible = True
swApp.UserControl = True
Set swModel = Nothing
Set swAssDoc = Nothing
Set swApp = Nothing
End Sub
‘ ————————————————————————-
‘ 再帰的コンポーネント走査プロシージャ（サブアセンブリ対応）
‘ ————————————————————————-
Private Sub TraverseComponent(ByVal swComp As SldWorks.Component2, ByVal parentPath As String, ByRef dataCount As Long, ByRef reportData() As Variant)
Dim swModel As SldWorks.ModelDoc2
Set swModel = swComp.GetModelDoc2()
If swModel Is Nothing Then Exit Sub ‘ 仮想部品や未解決参照のガード
‘ プロパティ値の変数
Dim compName As String
Dim partNumber As String
Dim materialName As String
Dim mass As Double
Dim volume As Double
Dim centerOfMass(2) As Double
compName = swComp.Name2
‘ カスタムプロパティ（部品番号など）の取得
Dim swCustPropMgr As SldWorks.CustomPropertyManager
Set swCustPropMgr = swModel.Extension.CustomPropertyManager(“”)
Dim valOut As String, resolvedOut As String
Dim wasResolved As Boolean
swCustPropMgr.Get6 “PartNumber”, False, valOut, resolvedOut, wasResolved, False
partNumber = resolvedOut
If partNumber = “” Then partNumber = swModel.GetTitle()
‘ 材質の取得
materialName = swModel.GetMaterialName()
If materialName = “” Then materialName = “未設定”
‘ 質量特性の取得 (MassProperties オブジェクト)
Dim swMassProp As SldWorks.MassProperty
Set swMassProp = swModel.Extension.CreateMassProperty()
If Not swMassProp Is Nothing Then
swMassProp.UseSystemUnits = True
mass = swMassProp.Mass
volume = swMassProp.Volume
‘ 重心位置取得 (Array)
Dim vCM As Variant
vCM = swMassProp.CenterOfMass
If Not IsEmpty(vCM) Then
centerOfMass(0) = vCM(0)
centerOfMass(1) = vCM(1)
centerOfMass(2) = vCM(2)
End If
Set swMassProp = Nothing
End If
‘ 配列の動的拡張 (ReDim Preserveのコストを抑えるためチャンク拡張が理想だが簡略化のため毎回拡張)
dataCount = dataCount + 1
ReDim Preserve reportData(1 To 7, 1 To dataCount)
reportData(1, dataCount) = IIf(parentPath = “”, compPath(compName), parentPath & ” > ” & compName)
reportData(2, dataCount) = compName
reportData(3, dataCount) = partNumber
reportData(4, dataCount) = materialName
reportData(5, dataCount) = mass
reportData(6, dataCount) = volume
reportData(7, dataCount) = centerOfMass(2) ‘ Z軸重心
‘ サブアセンブリの子要素を再帰的に走査
Dim vChildren As Variant
vChildren = swComp.GetChildren()
If Not IsEmpty(vChildren) Then
Dim j As Long
For j = LBound(vChildren) To UBound(vChildren)
Dim swChildComp As SldWorks.Component2
Set swChildComp = vChildren(j)
If Not swChildComp.IsSuppressed() Then
Call TraverseComponent(swChildComp, reportData(1, dataCount), dataCount, reportData)
End If
Set swChildComp = Nothing
Next j
End If
Set swCustPropMgr = Nothing
Set swModel = Nothing
End Sub
‘ 簡易ヘルパー
Private Function compPath(ByVal name As String) As String
compPath = name
End Function
‘ ————————————————————————-
‘ Excel高速出力エンジン（Variant配列の一括転送）
‘ ————————————————————————-
Private Sub OutputToExcel(ByRef data() As Variant, ByVal totalRows As Long)
Dim xlApp As Object
Dim xlWb As Object
Dim xlWs As Object
Set xlApp = CreateObject(“Excel.Application”)
xlApp.Visible = True
xlApp.ScreenUpdating = False
Set xlWb = xlApp.Workbooks.Add
Set xlWs = xlWb.Sheets(1)
xlWs.Name = “重量配分チェックシート”
‘ ヘッダー設定
Dim headers As Variant
headers = Array(“階層パス”, “コンポーネント名”, “部品番号 / 品名”, “材質”, “質量 (kg)”, “体積 (m^3)”, “重心 Z (m)”)
xlWs.Range(“A1:G1”).Value = headers
xlWs.Range(“A1:G1”).Font.Bold = True
xlWs.Range(“A1:G1”).Interior.Color = RGB(220, 230, 242)
‘ 転送用配列の転置 (VBAの1 to 7, 1 to N を Excelの N x 7 に変換)
Dim transposedData() As Variant
ReDim transposedData(1 To totalRows, 1 To 7)
Dim r As Long, c As Long
For r = 1 To totalRows
For c = 1 To 7
transposedData(r, c) = data(c, r)
Next c
Next r
‘ 一括書き込み（この1行がセル単位書き込みと比較して100倍以上の速度差を生む）
xlWs.Range(“A2”).Resize(totalRows, 7).Value = transposedData
‘ 書式設定・総計行の追加
Dim lastRow As Long
lastRow = totalRows + 1
xlWs.Cells(lastRow + 1, 4).Value = “合計質量”
xlWs.Cells(lastRow + 1, 5).Formula = “=SUM(E2:E” & lastRow & “)”
xlWs.Cells(lastRow + 1, 4).Font.Bold = True
xlWs.Cells(lastRow + 1, 5).Font.Bold = True
‘ 罫線とオートフィット
With xlWs.Range(“A1:G” & lastRow)
.Borders.LineStyle = 1 ‘ xlContinuous
.Columns.AutoFit
End With
xlApp.ScreenUpdating = True
‘ オブジェクト解放
Set xlWs = Nothing
Set xlWb = Nothing
Set xlApp = Nothing
End Sub
—
3. チーフアーキテクトが解説するコードの急所と極意
① `Extension.CreateMassProperty()` の圧倒的な優位性
旧来のAPIでは `ModelDoc2.GetMassProperties` が使われていたが、これは廃止予定（Obsolete）あるいは限定的な機能しか持たない。現代のSolidWorks APIでは、`ModelDoc2.Extension.CreateMassProperty()` を用いることで、精度の高い `MassProperty` オブジェクトを独立して生成できる。
さらに `UseSystemUnits = True` を明示することで、ドキュメント側の単位系に依存せず、SI単位系（kg, m）で安全にデータを回収することが可能になる。
② メモリリークを根絶する `Set X = Nothing` の徹底
VBAのガベージコレクションは参照カウント方式をとっている。特にSolidWorksのCOMオブジェクト（`Component2`, `ModelDoc2`, `MassProperty`）は、ループ内でインスタンス化されるため、スコープを抜けても明示的に `Set xxx = Nothing` を記述しない限り、メモリ上に残存し続ける。
上記のコードでは、全てのループ終端で確実にオブジェクトの参照を切断し、SolidWorksのプロセス安定性を担保している。
③ Variant配列の転置（Transposition）によるExcelI/Oの高速化
Excelのセルを `Cells(row, col).Value = val` とループで叩くコードを書くプログラマは、今すぐそのキーボードを置いてほしい。COMの境界を跨ぐコストはVBAにおいて最も重い処理の一つだ。
メモリ上で二次元配列（`transposedData`）を構築し、`Range.Resize().Value = transposedData` によって一撃でExcelへ流し込む。これにより、数千行のデータであっても一瞬で処理が完了する。
—
4. 現場への導入と運用保守の注意点
- 軽量モード（Lightweight）の扱い
大規模アセンブリでデフォルト有効になっている「軽量コンポーネント」は、実体ドキュメントが完全にメモリ上にロードされていない場合がある。`swComp.GetModelDoc2()` を呼ぶ際に自動解決（Resolve）が走るため、巨大アセンブリでは事前に「全部品の解決」を行わせるか、コード内で `swComp.SetSolveMode()` 等の状態を考慮する必要がある。
- カスタムプロパティ名の統一
社内ニッチな運用として「PartNumber」ではなく「部品番号」や「Drawing_No」など、プロパティ名がバラバラな場合は、`CustomPropertyManager.Get6` の引数を動的に切り替えるラッパー関数を挟むと堅牢性が増す。
—
結びにかえて
CADの自動化は、単なる「手作業の置き換え」ではない。それは設計プロセスの信頼性を数段引き上げ、ヒューマンエラーという名の不確実性をシステムで圧倒的にねじ伏せる行為そのものだ。
このコードをあなたの環境に組み込み、設計検証のスピードを次の次元へと引き上げてほしい。妥協なきエンジニアリングの健闘を祈る。
