【実務・中級編】【中級者向け】図面内の寸法線レイアウト自動整列：重なった寸法線を検知してオフセットを自動調整 – SolidWorks VBA解析バイブル

次元的な混沌を秩序へ：図面寸法レイアウト最適化のアーキテクチャ設計

図面自動生成マクロを開発しているエンジニアが、最初に直面する「壁」がある。それは、「寸法は自動配置できるが、整列させるのは至難の業である」という現実だ。

APIを使って寸法を書き出すことは容易だ。しかし、書き出した瞬間に寸法線が重なり、数値が読み取りにくくなる。これを「手動で直す」のは、自動化の敗北を意味する。かといって、単純な「一定間隔でオフセットする」ロジックを組めば、今度は寸法が図面外へ飛び出したり、形状を隠したりする。

本稿では、単なる「動かすマクロ」ではない。「重なりを検知し、数学的根拠に基づいて配置を最適化する」、プロダクションレベルの設計思想を伝授する。

1. なぜ、あなたの「寸法移動マクロ」は失敗するのか

多くの開発者が陥る罠は、`DisplayDimension` オブジェクトを単なる「点」として扱うことだ。

凡庸な設計の失敗要因

1. 再計算（Rebuild）の無視: 寸法を一つ動かすたびにSolidWorksの描画エンジンが走ると、計算量は $O(n^2)$ に膨れ上がり、大規模図面ではフリーズしたようになる。
2. 座標系の誤解: 図面の座標系（Drawing Sheet）と、各ビューの座標系（View Coordinate）の変換を怠り、意図しない方向に寸法が飛んでいく。
3. 衝突判定の欠如: 「寸法線」だけを見ている。実際には「寸法文字（Text）」と「補助線（Extension Line）」が衝突しているのだ。

プロフェッショナルの設計思想

堅牢なツールを作るには、以下の3ステップを分離して設計すべきである。
1. 抽出 (Extraction): 全寸法から「衝突判定用のバウンディングボックス（境界領域）」をメモリ上に構築する。
2. 解析 (Analysis): 座標空間上で、どのオブジェクトとどのオブジェクトが「衝突」しているかを判定する。
3. 適用 (Application): 衝突を解消する最小限のベクトルを計算し、最後に一括で座標を書き換える。

2. 実装の核：衝突検知アルゴリズム

寸法が重なっているかを判定するには、`Annotation` オブジェクトから取得できる位置情報を使用する。
実務的には、寸法文字の「中心座標」とその「高さ（フォントサイズに依存）」から、仮想的な矩形（Bounding Box）を作り、その矩形同士の重なり（Intersection）を計算するのが最も効率的だ。

3. プロダクション・コード例

以下に、図面内の寸法文字の重なりを検知し、垂直方向に自動オフセットする、保守性の高いクラスモジュール構成を意識したコードを示す。

'**
' Module: DimensionOptimizer
' Description: 図面内の寸法文字の重なりを検知し、垂直方向に整列させる
'**

Option Explicit

' 寸法情報を保持するための構造体
Private Type DimensionData
    Dim swDispDim As SldWorks.DisplayDimension
    Dim swAnn As SldWorks.Annotation
    Dim posX As Double
    Dim posY As Double
    Dim boxHeight As Double ' 衝突判定用の高さ
End Type

Sub OptimizeDimensionLayout()
    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 swDispDim As SldWorks.DisplayDimension
    
    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
    
    ' 高速化のための描画停止
    swModel.LockGraphics = True
    
    On Error GoTo ErrorHandler
    
    ' 2. 寸法データの収集
    Dim dimList As Collection
    Set dimList = New Collection
    
    ' 全ビューをループして寸法を取得
    Set swView = swDraw.GetFirstView ' Sheet自体が最初のビュー
    Do While Not swView Is Nothing
        Set swDispDim = swView.GetFirstDisplayDimension
        Do While Not swDispDim Is Nothing
            Call CollectDimensionData(swDispDim, dimList)
            Set swDispDim = swDispDim.GetNextDisplayDimension
        Loop
        Set swView = swView.GetNextView
    Loop
    
    If dimList.Count = 0 Then
        MsgBox "対象となる寸法が見つかりませんでした。", vbInformation
        GoTo Cleanup
    End If
    
    ' 3. 重なり判定と配置の最適化 (垂直方向の整列)
    ' 本来はここでソートアルゴリズム(QuickSort等)を使い、Y座標順に並べるのが定石
    Call ResolveOverlaps(dimList, swModel)
    
    ' 4. 再描画の有効化
    swModel.ForceRebuild3 True
    MsgBox "寸法レイアウトの最適化が完了しました。", vbInformation

Cleanup:
    swModel.LockGraphics = False
    Exit Sub

ErrorHandler:
    MsgBox "致命的なエラーが発生しました: " & Err.Description, vbCritical
    Resume Cleanup
End Sub

' 寸法オブジェクトから座標と判定用サイズを抽出する
Private Sub CollectDimensionData(swDispDim As SldWorks.DisplayDimension, ByRef dimList As Collection)
    Dim swAnn As SldWorks.Annotation
    Dim data As DimensionData
    
    Set swAnn = swDispDim.GetAnnotation
    
    ' 座標取得 (Annotationの座標系を使用)
    data.posX = swAnn.GetPositionX
    data.posY = swAnn.GetPositionY
    
    ' 衝突判定用の高さ（実務的にはフォントサイズに余裕を持たせた定数を使用）
    ' ここでは簡易的に 5mm (メートル単位なので 0.005) と定義
    data.boxHeight = 0.005 
    
    Set data.swDispDim = swDispDim
    Set data.swAnn = swAnn
    
    dimList.Add data
End Sub

' 衝突を解消するコアロジック
Private Sub ResolveOverlaps(dimList As Collection, swModel As SldWorks.ModelDoc2)
    Dim i As Long, j As Long
    Dim d1 As DimensionData
    Dim d2 As DimensionData
    Dim minDistance As Double
    
    ' 許容される最小間隔 (5mm)
    minDistance = 0.005
    
    ' 簡易的な二重ループによる衝突検知
    ' ※大規模図面では、空間分割(Spatial Partitioning)等の検討が必要
    For i = 1 To dimList.Count
        d1 = dimList(i)
        
        For j = i + 1 To dimList.Count
            d2 = dimList(j)
            
            ' X座標が近い（垂直方向に重なる可能性がある）場合のみ判定
            If Abs(d1.posX - d2.posX) < 0.01 Then ' 10mm以内のX軸距離
                
                ' Y軸方向の距離を計算
                Dim diffY As Double
                diffY = d1.posY - d2.posY
                
                ' 距離が最小間隔より小さい場合、オフセットを適用
                If Abs(diffY) < minDistance Then
                    ' 重なりを解消するようにd2のY座標をシフト
                    ' (d1を基準に、d2を押し上げる/押し下げる)
                    Dim newY As Double
                    If diffY > 0 Then
                        newY = d1.posY + minDistance
                    Else
                        newY = d1.posY - minDistance
                    End If
                    
                    ' 座標の書き換えを実行
                    ' 注意: AnnotationのSetPositionは描画更新を伴うため慎重に
                    d2.swAnn.SetPosition d2.posX, newY
                    
                    ' メモリ上のデータも更新（次の比較のため）
                    d2.posY = newY
                    dimList.Remove j
                    dimList.Add d2, Before:=j ' 更新したデータをリストに戻す
                End If
            End If
        Next j
    Next i
End Sub

4. アーキテクトの視点：実務への統合

このコードを「道具」から「システム」へ昇華させるために、以下の3点を考慮してください。

① パフォーマンスの極致

上記のコードでは、衝突検知に二重ループ（$O(n^2)$）を使用しています。小規模な図面なら問題ありませんが、数百の寸法がある図面では、「グリッド分割（Spatial Hashing）」を導入してください。図面を一定のグリッドに分割し、同じグリッド、あるいは隣接するグリッドに属する寸法のみを比較対象にすることで、計算量を劇的に削減できます。

② 外部パラメータの管理

`minDistance`（最小間隔）や `boxHeight`（判定高さ）をコード内にハードコードするのは、プロの仕事ではありません。これらは設定ファイル（XMLやJSON、あるいはExcel）から読み込むように設計してください。プロジェクトごとに「寸法書式標準」が異なるため、コードを書き換えずに設定を変更できる柔軟性が、ツールの寿命を決めます。

③ エラーハンドリングとロールバック

自動配置は時に、予期せぬ方向に寸法を飛ばします。
「実行前の図面状態を一時保存する」あるいは「変更した寸法オブジェクトのリストをスタックに積み、エラー時に元に戻す（Undo機能）」の実装を検討してください。ユーザーに「やり直し」の選択肢を与えることこそが、信頼されるエンジニアの作法です。

まとめ

寸法レイアウトの自動化は、単なる座標の移動ではない。「図面における視認性の数学的定義」をコードに落とし込む作業である。

今回示した「抽出 $\rightarrow$ 解析 $\rightarrow$ 一括適用」のフローをマスターすれば、あなたは単なる「マクロ作成者」を卒業し、製造現場の品質を支える「自動化アーキテクト」へと進化できるはずだ。