【上級プロ向け】図面内アノテーションの干渉を自動検出し、最適化する──SolidWorks VBAの深淵へようこそ
こんにちは。設計自動化の世界へようこそ。
「マクロの記録」ボタンを押して、生成されたコードを眺めて「ふむふむ、なるほど」……。そんな段階から一歩踏み出そうとしているあなた。その探究心、素晴らしいですね。
しかし、ここからが本当の戦いです。
「記録されたコード」は、あくまで「特定の操作を再現しただけの断片」に過ぎません。プロフェッショナルな自動化ツールを作るには、SolidWorksが裏側でどのようにオブジェクトを管理し、座標を計算しているのかという「設計思想（アーキテクチャ）」を理解する必要があります。
今日は、図面作成における最難関の一つ、「幾何公差や表面粗さ記号（アノテーション）の重なり（干渉）を検出し、自動で位置を微調整する」という、極めて高度で実用的なモジュールの作り方を伝授します。
これに挑戦できれば、あなたはもう「マクロ使い」ではなく、「自動化エンジニア」の仲間入りです。
1. なぜ「アノテーションの配置」は難しいのか？
図面を書いているとき、幾何公差記号が図形や他の寸法と重なってしまい、「見にくい！」と思ったことはありませんか？
これをプログラムで解決しようとすると、初心者の方は必ずと言っていいほど「座標の迷宮」に迷い込みます。理由は大きく分けて2つあります。
① 座標系の多重構造
SolidWorksの図面には、複数の「座標の基準」が存在します。
- シート座標系: 紙の左下を基準とした座標。
- ビュー座標系: 各図面ビュー（投影図）の中での相対的な座標。
- アノテーションの原点: 記号自体の中心や端点。
「ビューを動かしたら、記号が置いてけぼりになった」というのは、この座標系の変換を理解していないために起こる典型的なエラーです。
② 「見た目」と「データ」の乖離
アノテーションは単なる「点」ではありません。幅があり、高さがあります。
「座標が一致していないから重なっていない」という判定は、プロの現場では通用しません。「矩形（バウンディングボックス）が重なっているか」を計算する必要があるのです。
2. アルゴリズムの設計図：衝突判定のロジック
今回は、効率的なAABB（Axis-Aligned Bounding Box）というアルゴリズムを使用します。これは、各記号を「縦・横・X・Y」を持つ四角形として捉え、その四角形同士が重なっているかを判定する手法です。
判定ロジックの条件：
2つの記号 $A$ と $B$ が重なっている条件は、以下のすべてを満たす時です。
1. $A$ の左端 $<$ $B$ の右端
2. $A$ の右端 $>$ $B$ の左端
3. $A$ の上端 $>$ $B$ の下端
4. $A$ の下端 $<$ $B$ の上端
このシンプルな論理を、VBAのループ処理に落とし込んでいきます。
3. 実装コード：アノテーション干渉検出モジュール
それでは、魂を込めて書いたコードを公開します。このコードは、図面内の全アノテーションをスキャンし、重なりを検知して、コンソールに警告を出す（あるいは微調整の準備をする）ための骨格です。
'**
' Module: AnnotationCollisionDetector
' Description: 図面内のアノテーション（幾何公差等）の重なりを検出し、
' 座標解析を行うプロフェッショナル向けプロトタイプ。
'**
Option Explicit
' アノテーションの情報を保持するためのカスタム型
Private Type AnnotationInfo
ID As Long
X As Double
Y As Double
Width As Double
Height As Double
Type As Long ' アノテーションの種類
End Type
Sub DetectAndOptimizeAnnotations()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Dim swSheet As SldWorks.Sheet
Dim swView As SldWorks.View
Dim swAnn As SldWorks.Annotation
Dim annoList() As AnnotationInfo
Dim count As Long
Dim i As Long, j As Long
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
' 1. エラーチェック: 図面が開かれているか？
If swModel Is Nothing Then Exit Sub
If swModel.GetType <> swDocDRAWING Then
MsgBox "図面ファイルを開いてから実行してください。", vbCritical
Exit Sub
End If
Set swDraw = swModel
Set swSheet = swDraw.GetCurrentSheet
count = 0
' 2. 全ビューを走査してアノテーション情報を収集
' ※ 最初のビューはシート自体を指すため、ループの回し方に注意
Set swView = swDraw.GetFirstView ' シート（紙）
Do While Not swView Is Nothing
' ビュー内のアノテーションを取得
Set swAnn = swView.GetFirstAnnotation
Do While Not swAnn Is Nothing
' アノテーションの種類を確認 (幾何公差、表面粗さ、寸法など)
' ここでは全ての注釈を対象とする
If swAnn.GetType <> swAnnotationType_e.swAnnotationType_None Then
count = count + 1
ReDim Preserve annoList(1 To count)
' 座標とサイズを取得 (Bounding Boxの概念)
' GetPositionはビュー座標系での位置を返す
Dim pos As Variant
pos = swAnn.GetPosition
' 矩形範囲の取得 (実際にはAnnotationの境界を取得する高度なAPIが必要)
' ここでは簡易的に、位置と固定のサイズ、またはGetAnnotationDataを活用
annoList(count).ID = swAnn.GetAnnotationID
annoList(count).X = pos(0)
annoList(count).Y = pos(1)
' 【重要】本来はGetBoundingBox等のAPIを使用するが、
' 簡易化のため、ここでは仮のサイズを設定
' 実際の開発では、テキストの幅などを計算するロジックをここに組み込む
annoList(count).Width = 0.02 ' 仮: 20mm
annoList(count).Height = 0.01 ' 仮: 10mm
annoList(count).Type = swAnn.GetType
End If
Set swAnn = swAnn.GetNextAnnotation
Loop
Set swView = swView.GetNextView
Loop
' 3. 干渉判定アルゴリズム (AABB)
Debug.Print "--- 干渉検出開始 ---"
Dim collisionFound As Boolean
collisionFound = False
For i = 1 To count
For j = i + 1 To count
' 重なり判定
If IsOverlapping(annoList(i), annoList(j)) Then
Debug.Print "【警告】干渉検出: ID " & annoList(i).ID & " と ID " & annoList(j).ID
Debug.Print " 位置1: (" & annoList(i).X & ", " & annoList(i).Y & ")"
Debug.Print " 位置2: (" & annoList(j).X & ", " & annoList(j).Y & ")"
' 4. 自動微調整ロジック (簡易版: Y軸方向に少しずらす)
' 本来は、重なりが最小になる方向を計算する
MoveAnnotation swModel, annoList(i).ID, 0, 0.005
collisionFound = True
End If
Next j
Next i
If Not collisionFound Then
MsgBox "干渉は見つかりませんでした。クリーンな図面です！", vbInformation
Else
MsgBox "干渉を検出し、一部の位置を調整しました。確認してください。", vbExclamation
End If
' メモリ解放の作法
Set swDraw = Nothing
Set swModel = Nothing
Set swApp = Nothing
End Sub
' 矩形の重なりを判定する関数
Private Function IsOverlapping(a As AnnotationInfo, b As AnnotationInfo) As Boolean
IsOverlapping = (a.X < b.X + b.Width And _
a.X + a.Width > b.X And _
a.Y < b.Y + b.Height And _
a.Y + a.Height > b.Y)
End Function
' 指定したIDのアノテーションを移動させる関数
Private Sub MoveAnnotation(swModel As SldWorks.ModelDoc2, annoID As Long, dx As Double, dy As Double)
Dim swApp As SldWorks.SldWorks
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swSelMgr As SldWorks.SelectionMgr
Dim swAnn As SldWorks.Annotation
Dim pos As Variant
Set swApp = swModel.GetApplication
' IDから直接オブジェクトを取得するのは難しいため、SelectionMgrを活用するのが定石
' ※ 本来は全スキャンしてIDで照合するが、ここでは概念を示す
' ここでは、移動の概念を示すための擬似コード的な実装
' 実際には、swModel.Extension.SelectByID2 を使用して対象を選択し、
' swAnnotation.SetPosition を呼び出す
Debug.Print " -> ID " & annoID & " を移動中..."
End Sub4. 伝説のアーキテクトが教える「陥りやすい罠」
このコードを動かそうとしたとき、あるいはさらに発展させようとしたとき、あなたは必ず以下の壁にぶつかります。これを知っているかどうかが、初級者とプロの違いです。
罠その1：計算精度の問題（Floating Point Error）
コンピュータの世界では、`0.1 + 0.2` は厳密には `0.3` になりません。座標の比較を行うときは、`If a.X = b.X` のような完全一致は避け、`If Abs(a.X – b.X) < 0.00001` のように許容誤差（Epsilon）を持たせて比較してください。
罠その2：オブジェクトのライフサイクル
VBAは非常にメモリ管理がデリケートです。特に `Do While Not swAnn Is Nothing` のようなループの中で、`Set swAnn = swAnn.GetNextAnnotation` を忘れたり、ループの途中でオブジェクトを破壊（Delete）したりすると、SolidWorksが即座にクラッシュします。「参照を辿る時は、常に次があることを確認する」。これが鉄則です。
罠その3：パフォーマンスの重み
図面内に数千個のアノテーションがある場合、二重ループ（$O(n^2)$）は非常に重くなります。
プロの現場では、「空間分割（Spatial Partitioning）」という手法を使います。画面を格子状（グリッド）に区切り、同じ格子内にいるアノテーション同士だけを比較することで、計算量を劇的に減らすのです。
5. まとめ：次の一歩へ
今回紹介したコードは、あくまで「エンジンの設計図」です。
これをベースに、
- 「重なっているときは、どちらをどちらの方向に逃がすべきか？」
- 「図形の線と重なっている場合はどうするか？」
といったロジックを肉付けしていくことで、世界に一つだけの最強の自動化ツールが完成します。
「マクロの記録」で得た断片的な知識を、これらの「構造的な考え方」で繋ぎ合わせてください。その先に、設計業務を劇的に変える魔法のツールが待っています。
ここをクリアすれば、SolidWorks VBAの基本はバッチリですよ。
さあ、コードを書き始めましょう！
