【テクニカル・上級編】【中級者向け】図面内の寸法線が交差・重複した際に自動検知してオフセット間隔を再計算するレイアウトマクロ – SolidWorks VBA解析バイブル

【極限の図面制御】次元の衝突を数学的に制圧する：寸法線自動レイアウト・エンジニアリングの真髄

図面作成の自動化において、多くのエンジニアが「寸法を配置する」という初歩的なフェーズで満足し、その先に待ち受ける「視認性の地獄」を見落としている。

自動挿入された寸法線が互いに交差し、テキストが重なり、図面としての品位を損なう。これは単なる見た目の問題ではない。設計情報の誤読を招き、製造現場での致命的なミスに直結する「品質管理上の欠陥」である。

本稿では、単なるAPIの呼び出し手順などという初歩的な話はしない。寸法線の幾何学的座標を抽出し、衝突判定アルゴリズムに基づき、最適なオフセット間隔を再計算・適用するための、極限のレイアウト制御アーキテクチャについて論じる。

1. アーキテクチャの設計思想：COMオーバーヘッドとの戦い

SolidWorks VBA（COM）を利用する際、最大のボトルネックは「API呼び出しの回数」である。
`DisplayDimension` オブジェクトに対して、ループ内で逐次 `GetTextPosition` や `SetTextPosition` を呼び出す行為は、COMブリッジを介した通信コストを増大させ、数千個の寸法を持つ大規模アセンブリ図面では致命的なパフォーマンス低下を招く。

我々が取るべき戦略は、「データ抽出の局所化」と「一括計算・一括適用」である。

1. Extraction Phase: 図面内の全 `DisplayDimension` から、座標情報と次元の「厚み（Bounding Box相当）」をメモリ上の構造体（または型定義された配列）に一括で吸い出す。
2. Calculation Phase: SolidWorksのエンジンを介さず、メモリ内の数値計算のみで衝突を検知し、新しい座標を算出する。
3. Application Phase: 計算済みの座標を、最小限のAPIコールで一気に書き戻す。

この分離こそが、プロフェッショナルな自動化システムに求められる設計思想である。

2. 幾何学的衝突検知と再配置アルゴリズム

寸法線の衝突を検知するには、各寸法を単なる点ではなく、「線分（Line Segment）」または「矩形（Bounding Box）」として定義する必要がある。

ここでは、垂直方向の寸法線が重なっているケースを想定し、以下のアルゴリズムを適用する。

アルゴリズムの定式化

1. 対象となるビュー内の全寸法を、中心座標の $Y$ 軸（または $X$ 軸）に従ってソートする。
2. 隣接する寸法 $D_i$ と $D_{i+1}$ の間隔 $\Delta Y = |Y_{i+1} – Y_i|$ を算出する。
3. $\Delta Y < \text{Threshold}$（最小許容間隔）である場合、衝突と判定する。 4. 衝突時、$\Delta Y$ が $\text{Threshold}$ になるよう、後続の寸法を連鎖的にオフセット（Pushing Algorithm）する。

3. 実装：極限のパフォーマンスを引き出すVBAコード

以下に、実戦投入を想定したコードの骨子を示す。ここでは、メモリリークを防ぐための明示的なオブジェクト解放と、描画更新の抑制（Performance Optimization）を組み込んでいる。

Option Explicit

' Windows API: 高精度なタイミング計測用 (パフォーマンスプロファイリング)
Private Declare PtrSafe Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCounter As ULong64) As Long
Private Declare PtrSafe Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As ULong64) As Long

' 寸法データを保持するためのカスタム構造体（VBAではTypeを使用）
Private Type DimensionData
    Dim swDispDim As Object ' DisplayDimension
    Dim posX As Double
    Dim posY As Double
    Dim textHeight As Double
    Dim targetY As Double
End Type

Sub OptimizeDimensionLayout()
    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim swDraw As SldWorks.DrawingDoc
    Dim swView As SldWorks.View
    Dim swDispDim As SldWorks.DisplayDimension
    
    Dim dimArray() As DimensionData
    Dim dimCount As Long
    Dim i As Long, j As Long
    Dim minSpacing As Double
    
    ' パフォーマンス計測用
    Dim startTick As ULong64, endTick As ULong64, freq As ULong64
    QueryPerformanceFrequency freq
    QueryPerformanceCounter startTick

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    
    If swModel Is Nothing Or swModel.GetType <> swDocDRAWING Then
        MsgBox "図面ファイルを開いてください。"
        Exit Sub
    End If
    
    Set swDraw = swModel
    
    ' --- Optimization Phase 1: 描画更新の停止 ---
    ' API経由での描画更新は極めて重いため、計算が終わるまで抑制する
    swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swDrawingDisplayAnnotationUpdate, False
    
    ' 最小許容間隔 (単位はメートル。例: 5mm = 0.005)
    minSpacing = 0.005 

    ' 現在のビューを取得（ここではアクティブビューを対象とする）
    Set swView = swDraw.GetActiveView
    
    ' --- Extraction Phase: メモリへのデータ吸い出し ---
    dimCount = 0
    Set swDispDim = swView.GetFirstDisplayDimension
    
    Do While Not swDispDim Is Nothing
        dimCount = dimCount + 1
        ReDim Preserve dimArray(1 To dimCount)
        
        With dimArray(dimCount)
            Set .swDispDim = swDispDim
            ' 寸法の中心座標を取得
            Dim vPos As Variant
            vPos = swDispDim.GetTextPosition
            .posX = vPos(0)
            .posY = vPos(1)
            ' 本来はここでテキストの高さ等を計算するが、簡略化のため定数または近似を使用
            .textHeight = 0.003 
            .targetY = .posY
        End With
        
        Set swDispDim = swDispDim.GetNextDisplayDimension
    Loop

    If dimCount < 2 Then GoTo CleanUp

    ' --- Calculation Phase: 衝突検知と再配置ロジック ---
    ' 1. Y座標でソート (簡易的なバブルソート。件数が極端に多ければクイックソートを実装すべき)
    For i = 1 To dimCount - 1
        For j = i + 1 To dimCount
            If dimArray(i).posY > dimArray(j).posY Then
                Dim temp As DimensionData
                Set temp = dimArray(i)
                Set dimArray(i) = dimArray(j)
                Set dimArray(j) = temp
            End If
        Next j
    Next i

    ' 2. 衝突判定と押し出し計算
    For i = 1 To dimCount - 1
        ' 隣接する寸法との距離をチェック
        Dim diff As Double
        diff = dimArray(i + 1).targetY - dimArray(i).targetY
        
        ' 許容間隔を下回っている場合
        If diff < minSpacing Then
            ' 次の寸法の位置を、現在の寸法 + 最小間隔 に強制設定
            dimArray(i + 1).targetY = dimArray(i).targetY + minSpacing
            ' 連鎖的に後ろの寸法を押し出す必要があるため、再帰的またはループで調整
            ' ここでは簡略化のため、次のループで処理されることを期待する設計とする
        End If
    Next i

    ' --- Application Phase: 座標の書き戻し ---
    ' 変更があった場合のみAPIを叩く
    For i = 1 To dimCount
        If Abs(dimArray(i).posY - dimArray(i).targetY) > 0.000001 Then
            ' 寸法線の位置を更新
            ' 注意: GetTextPositionで取得した座標をそのままSetTextPositionに渡す
            ' 実際には、寸法線の向き（水平・垂直）に応じてXかYを選択する必要がある
            Dim newPos(2) As Double
            newPos(0) = dimArray(i).posX
            newPos(1) = dimArray(i).targetY
            newPos(2) = 0
            
            dimArray(i).swDispDim.SetTextPosition newPos
        End If
    Next i

CleanUp:
    ' --- Optimization Phase 2: 設定の復元と描画更新 ---
    swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swDrawingDisplayAnnotationUpdate, True
    swModel.ForceRebuild3 True
    
    ' パフォーマンス計測終了
    QueryPerformanceCounter endTick
    Debug.Print "Execution Time: " & (endTick - startTick) / freq & " seconds"

    ' --- Memory Management: オブジェクトの明示的解放 ---
    ' VBAのガベージコレクションに頼らず、重いオブジェクトは明示的にNothingを代入する
    Set swDispDim = Nothing
    Set swView = Nothing
    Set swDraw = Nothing
    Set swModel = Nothing
    Set swApp = Nothing
    
    MsgBox "レイアウト最適化が完了しました。"
End Sub

4. エンジニアリング・ノート：レガシー環境と保守性への配慮

この実装を実務に投入する際、以下の3点に留意せよ。

I. 数値精度の問題 (Floating Point Precision)

SolidWorksの内部演算はダブル精度（Double）であるが、比較演算において `If diff < minSpacing` のような単純な比較は危険である。浮動小数点誤差により、意図しない判定が行われる可能性がある。必ず `If diff < (minSpacing - epsilon)` のように、微小値（Epsilon）を用いたバッファを持たせること。

II. メモリ管理の極意

VBAにおいて `Set obj = Nothing` は、単なる作法ではない。特に `DisplayDimension` や `View` のような、大量のプロパティを持つCOMオブジェクトをループ内で扱う場合、明示的な解放を怠ると、SolidWorksのプロセス自体がメモリリークを起こし、最終的に `Out of Memory` でクラッシュする。大規模なシステムを運用する者は、この「オブジェクトのライフサイクル」を完全に制御下に置かなければならない。

III. ユーザーインターフェースの整合性

`swDrawingDisplayAnnotationUpdate` を `False` に設定することは、計算速度を劇的に向上させるが、ユーザーには「何も起きていない」ように見える。処理が長時間に及ぶ可能性がある場合、Windows APIの `StatusBar` を操作して進捗を表示するか、あるいは処理中のダイアログを適切に制御する。これは、システムとしての信頼性を担保するための最低限のマナーである。

結論

図面の自動レイアウトは、単なる「座標の書き換え」ではない。それは、幾何学的な制約条件下における、最適解の探索プロセスである。

APIの仕様をなぞるだけのエンジニアは、ツールに使われる。
オブジェクトの重みを知り、数学的に空間を支配するエンジニアこそが、真に自動化を「掌握」することができるのだ。