SolidWorks VBAを掌握する極限の知見
【形状検証・検査】IMeasureを使った自動寸法測定と設計逸脱の自動検出基盤
設計現場において、3Dモデルの品質担保はプロジェクトの成否を分ける生命線だ。しかし、膨大な数のパーツに対して、設計変更のたびに手動で寸法を測り、図面やExcelと突き合わせる作業がいかに非生産的か、君も痛感していることだろう。
「このフィレットRは本当に許容値に収まっているか？」
「指定した面間の距離に狂いはないか？」
今回は、SolidWorks APIの隠れた（あるいは使いこなされていない）実力者である `IMeasure` オブジェクト を駆使し、VBAからプログラム制御で正確な幾何測定を行い、設計許容値からの逸脱を検知・レポートする「品質管理自動化マクロ」の全貌を授ける。
ネット上の浅薄なサンプルコードをコピペして「動かない」「重い」と悩むフェーズは、今日で終わりだ。プロダクション環境に耐えうる、堅牢で洗練されたアーキテクトのコードを公開する。
—
なぜ `IMeasure` なのか？ 設計思想の理解
まず、大前提として知っておくべきことがある。SolidWorks APIには、寸法を測定する方法がいくつか存在する。しかし、画面上のエンティティ（面、エッジ、頂点）を指定して動的に計測を行う場合、`IModelDocExtension::CreateMeasure` から生成される `IMeasure` インターフェースを使用するのが最も直感的かつ強力だ。
ここで素人が陥る罠がある。
- 「フィーチャの寸法（Dimension）を直接取得すればいいのでは？」
→ それは設計意図（パラメータ）の確認にすぎない。実際に製造される3D形状がどうなっているかという「実測値（幾何学的結果）」とは必ずしも一致しない。アセンブリの干渉、合致のエラー、微小なフィーチャの破綻などによって生じる「形状のズレ」を検知するには、`IMeasure` による物理的な空間測定が不可欠なのだ。
—
堅牢な自動検査ツールのアーキテクチャ
今回のツールは、単に距離を測って終わりではない。以下の要件を満たすプロダクションクオリティで設計する。
1. 事前バインド（Early Binding）の徹底: 開発効率と実行速度を担保するため、型ライブラリを参照する。
2. 安全なオブジェクトライフサイクル管理: 選択セットのクリアやCOMオブジェクトの適切な解放を怠らない。
3. 許容値判定ロジックの分離: 測定値と閾値（上限・下限）を比較し、逸脱があれば即座にログを吐く。
—
実装コード：自動測定＆逸脱検出エンジン
以下のコードは、アクティブなパーツドキュメントを開いた状態で実行することを想定している。今回は「特定の2面間の距離」を測定し、あらかじめ設定した許容値（上下限）から逸脱していないかを検証する実用的なモジュールだ。
Option Explicit
‘ =================================================================================
‘ 建築・機械設計向け 品質管理自動検査エンジン
‘ Architecture & Code by 首席チーフアーキテクト
‘ =================================================================================
Public Sub ExecuteGeometricInspection()
‘ 1. アプリケーションおよびドキュメントの取得
Dim swApp As SldWorks.SldWorks
Dim swPart As SldWorks.ModelDoc2
Set swApp = Application.SldWorks
Set swPart = swApp.ActiveDoc
‘ ガード節: パーツが開かれていない、またはパーツドキュメントではない場合
If swPart Is Nothing Then
MsgBox “アクティブなドキュメントが存在しません。”, vbCritical, “致命的エラー”
Exit Sub
End If
If swPart.GetType <> swDocPART Then
MsgBox “このマクロはパーツファイル（.sldprt）専用です。”, vbExclamation, “対象外ファイル”
Exit Sub
End If
‘ 2. 検査対象のエンティティ（面など）を事前に選択状態にするか、
// またはAPI経由で面を特定して取得する。
// ここでは実用性を考慮し、ユーザーが手動選択した2つの面に対して測定を行う設計とする。
Dim swSelMgr As SldWorks.SelectionMgr
Set swSelMgr = swPart.SelectionManager
If swSelMgr.GetSelectedObjectCount2(-1) < 2 Then MsgBox "測定・検証を行うためのエンティティ（面やエッジ）を2つ選択してください。", vbExclamation, "選択不足" Exit Sub End If ' 3. IMeasure オブジェクトの生成 Dim swModelExt As SldWorks.ModelDocExtension Set swModelExt = swPart.Extension Dim swMeasure As SldWorks.Measure Set swMeasure = swModelExt.CreateMeasure() If swMeasure Is Nothing Then MsgBox "IMeasureオブジェクトの生成に失敗しました。", vbCritical, "APIエラー" Exit Sub End If ' 測定精度・設定の初期化（必要に応じて貫通計算などを有効化） swMeasure.ArcOption = 0 ' デフォルト設定 ' 4. 選択されたエンティティをMeasureにアサインして計算実行 ' 注: IMeasureは現在の選択セットを暗黙的に評価するため、 ' SelectEntity関数の戻り値やCalculateの成否を厳密にチェックする。 Dim bStatus As Boolean bStatus = swMeasure.Calculate(swPart) If Not bStatus Then MsgBox "幾何測定の計算に失敗しました。幾何学的に不正な選択の可能性があります。", vbCritical, "計算エラー" Exit Sub End If ' 5. 測定結果（距離）の取得 ' コマンドによって取得できる値（DistBetween, ArrayData等）を使い分ける Dim measuredDistance As Double measuredDistance = swMeasure.DistBetween 1000 ' メートルからミリメートルへ変換 ' 選択をクリア（メモリと視覚的ノイズの排除） swPart.ClearSelection2 True ' 6. 設計許容値（Tolerance）との比較・逸脱検出ロジック ' ※実際の運用では、これらを外部INIファイルやExcel、カスタムプロパティから読み込む Const TARGET_VAL As Double = 50.0 ' 設計公称値 (mm) Const TOL_UPPER As Double = 0.2 ' 上側許容差 (mm) Const TOL_LOWER As Double = -0.2 ' 下側許容差 (mm) Dim upperLimit As Double: upperLimit = TARGET_VAL + TOL_UPPER Dim lowerLimit As Double: lowerLimit = TARGET_VAL + TOL_LOWER Dim isPassed As Boolean isPassed = (measuredDistance >= lowerLimit) And (measuredDistance <= upperLimit) ' 7. 結果のレポート（UI出力 ＆ ログ記録） Dim reportMessage As String reportMessage = "【形状検査レポート】" & vbCrLf & _ "----------------------------------------" & vbCrLf & _ "目標値: " & TARGET_VAL & " mm" & vbCrLf & _ "許容範囲: " & lowerLimit & " 〜 " & upperLimit & " mm" & vbCrLf & _ "実測値: " & Format(measuredDistance, "0.000") & " mm" & vbCrLf & _ "----------------------------------------" & vbCrLf If isPassed Then reportMessage = reportMessage & "判定結果: 【 合格 (PASS) 】" MsgBox reportMessage, vbInformation, "品質検査完了" Else reportMessage = reportMessage & "判定結果: 【 異常・逸脱検出 (NG) 】" & vbCrLf & _ "警告: 設計許容値から外れています！" MsgBox reportMessage, vbCritical, "【警告】品質基準逸脱" ' 応用: ここでログファイルへの書き出しや、Excelへのデータ転記処理を呼び出す Call WriteLogToFile(swPart.GetPathName, measuredDistance, "NG") End If End Sub ' ================================================================================= ' 補助関数: 異常値を外部ログに記録する堅牢な実装 ' ================================================================================= Private Sub WriteLogToFile(filePath As String, value As Double, status As String) On Error GoTo ErrorHandler Dim fso As Object Set fso = CreateObject("Scripting.FileSystemObject") Dim logPath As String logPath = "C:\SolidWorks_Inspection_Logs\Quality_Report.csv" ' ログフォルダの自動生成 Dim logDir As String logDir = fso.GetParentFolderName(logPath) If Not fso.FolderExists(logDir) Then fso.CreateFolder logDir End If ' CSVへの追記 Dim ts As Object If Not fso.FileExists(logPath) Then Set ts = fso.CreateTextFile(logPath, True) ts.WriteLine "Timestamp,FilePath,MeasuredValue,Status" Else Set ts = fso.OpenTextFile(logPath, 8, True) ' 8 = ForAppending End If ts.WriteLine Now & "," & filePath & "," & value & "," & status ts.Close Exit Sub ErrorHandler: ' ログ書き込みエラーでメイン処理を止めないよう、サイレントに処理するかイミディエイトに出力 Debug.Print "ログ書き込み失敗: " & Err.Description End Sub ---
プロダクションコードの急所：エンジニアが押さえるべき3つのポイント
1. 単位系の意識（MKS vs MMGS）
SolidWorks APIが内部で返す値は、原則としてSI単位系（メートル、ラジアン、キログラム）だ。今回のコードで ` 1000` を行っているのはそのためだ。ここを怠ると、図面上の「50mm」を「0.05m」と誤認し、デバッグの迷宮に迷い込むことになる。APIを叩くときは常に「内部単位系」を意識せよ。
2. 選択セットの不整合を防ぐガード節
`IMeasure` は、現在選択されているオブジェクトをコンテキストとして動く。そのため、ユーザーが予期せぬ選択をした状態でマクロを走らせると、ハングアップや不正な値の取得につながる。処理の冒頭で `SelectionManager` のカウントを厳密にバリデーションし、安全性を担保している点に注目してほしい。
3. 例外処理とフェイルセーフ
CADの自動化において、外部ファイル（ログ等）のI/OエラーでCAD本体までクラッシュすることは絶対に避けなければならない。`On Error GoTo` を適切に配置し、万が一ログ保存に失敗しても、設計者へのアラート表示（メッセージボックス）まで確実に処理が到達する堅牢な構造にしている。
—
まとめ：自動化の先にあるもの
この `IMeasure` を活用した自動検査基盤を組織に導入すれば、設計レビューのリードタイムは劇的に短縮される。さらに、このマクロを拡張して「フォルダ内の全パーツを一括バッチ処理し、Excelへ合否一覧を出力する」ようなシステムへと昇華させれば、あなたのチームは「単純作業」から完全解放される。
API仕様の裏側を読み解き、ロジカルに組み上げられたコードこそが、真の業務効率化をもたらす。
さあ、この知見をあなたの開発環境に実装し、設計の自動化領域を次のステージへと引き上げてくれ。
