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

スポンサーリンク
スポンサーリンク

【極限の知見】図面の美しさは「計算」で決まる:寸法線の重複検知と自動オフセットアルゴリズム

「マクロの記録」ボタンを押し、手動で行った操作をコードに書き出す。
多くのエンジニアがここからSolidWorks VBAの世界に足を踏み入れます。しかし、残念ながら「記録」されたコードは、単なる操作の残像に過ぎません。

「もし、寸法線が重なっていたら?」「もし、もっと間隔を空けたいと言われたら?」
こうした「条件に応じた判断」こそが、マクロを「ただの自動化ツール」から「知的なエージェント」へと進化させる鍵となります。

今回は、図面作成の現場で最も泥臭く、かつ最も時間を奪われる作業の一つである「寸法線の重なり整理」をテーマに、数学的アプローチを用いた自動整列アルゴリズムを解剖していきましょう。

ここをクリアすれば、あなたは「記録」の呪縛から解き放たれ、SolidWorks VBAの真の支配者への一歩を踏み出すことができます。

1. 思考の設計図:どうやって「重なり」を見抜くのか?

プログラミングにおいて、最も重要なのはコードを書くことではなく、「現象をどう数値化するか」という設計です。

図面上の寸法線は、コンピュータにとっては「特定の座標(X, Y)を持つ、一定の大きさを持ったオブジェクト」です。重なりを検知するためには、以下のステップを踏む必要があります。

1. 対象の抽出: 図面内のすべての「Annotation(注記/寸法)」をリストアップする。
2. 境界ボックス(Bounding Box)の取得: 各寸法が占有している「最小の長方形領域」の座標を取得する。
3. 衝突判定: 2つの長方形が重なっているか、あるいは距離が近すぎるかを計算する。
4. 位置の再計算: 重なっている場合、重ならない最小限の距離まで、片方の座標をスライドさせる。

この「境界ボックス」という考え方は、ゲーム開発やAIの物体検知でも使われる非常に強力な概念です。

2. 実装:寸法線自動オフセット・マクロ

それでは、具体的なコードを見ていきましょう。このコードは、単純な記録マクロとは一線を画す、オブジェクト指向的なアプローチをとっています。

Option Explicit

' ==============================================================================
' テーマ: 寸法線の重複検知および自動オフセット
' 概要: 図面内の注記を走査し、境界ボックスが重なる場合に位置を自動調整する
' ==============================================================================

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 swAnn As SldWorks.Annotation
    
    ' 判定用の定数 (単位はメートル: SolidWorks APIの基本単位)
    ' 5mmの隙間を確保したい場合は 0.005 と指定
    Const MIN_GAP As Double = 0.005
    
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    
    ' 図面ドキュメントかチェック
    If swModel Is Nothing Or swModel.GetType <> swDocDRAWING Then
        MsgBox "図面ファイルを開いてから実行してください。", vbCritical
        Exit Sub
    End If
    
    Set swDraw = swModel
    Set swSheet = swDraw.GetCurrentSheet
    
    ' 1. 全ビューを走査(シートそのものも含む)
    Set swView = swDraw.GetFirstView ' FirstViewはシート自体を指す
    
    ' 注記オブジェクトを格納するコレクション(後の比較用)
    Dim annList As Collection
    Set annList = New Collection
    
    ' --- STEP 1: 全ての注記を収集 ---
    Do While Not swView Is Nothing
        Set swAnn = swView.GetFirstAnnotation2
        Do While Not swAnn Is Nothing
            ' 寸法や注記のみを対象とする
            If swAnn.GetType = swAnnotationType_e.swAnnotationType_Dimension Or _
               swAnn.GetType = swAnnotationType_e.swAnnotationType_Note Then
                
                ' 注記の情報をカスタムクラスのように扱うため、配列に格納
                ' [0]: Annotationオブジェクト, [1]: 境界ボックス(Array of 6 doubles)
                Dim info(1) As Variant
                Set info(0) = swAnn
                info(1) = swAnn.GetBoundingBox
                annList.Add info
            End If
            Set swAnn = swAnn.GetNextAnnotation2
        Loop
        Set swView = swView.GetNextView
    Loop
    
    ' --- STEP 2: 重複判定と位置調整 ---
    Dim i As Long, j As Long
    Dim currentAnn As SldWorks.Annotation
    Dim targetAnn As SldWorks.Annotation
    Dim box1 As Variant, box2 As Variant
    Dim x1 As Double, y1 As Double, x2 As Double, y2 As Double
    Dim tx1 As Double, ty1 As Double, tx2 As Double, ty2 As Double
    
    ' 二重ループによる総当たり比較 (計算量 O(n^2))
    ' ※実務的な図面数ならこれで十分高速です
    For i = 1 To annList.Count
        For j = i + 1 To annList.Count
            
            Set currentAnn = annList(i)(0)
            Set targetAnn = annList(j)(0)
            box1 = annList(i)(1)
            box2 = annList(j)(1)
            
            ' 境界ボックス座標の抽出 (x_min, y_min, z_min, x_max, y_max, z_max)
            x1 = box1(0): y1 = box1(1)
            x2 = box1(3): y2 = box1(4)
            tx1 = box2(0): ty1 = box2(1)
            tx2 = box2(3): ty2 = box2(4)
            
            ' --- 衝突判定アルゴリズム (AABB: Axis-Aligned Bounding Box) ---
            ' 二つの長方形が重なっているか、または隙間が MIN_GAP 未満か
            If Not (x2 + MIN_GAP < tx1 Or tx2 + MIN_GAP < x1 Or _
                    y2 + MIN_GAP < ty1 Or ty2 + MIN_GAP < y1) Then
                
                ' 重なりを検知した場合、targetAnn(j) を X方向にオフセットさせる例
                ' 本来は重なり方(上下左右)に応じて計算が必要ですが、
                ' ここではシンプルに「右側に押し出す」ロジックを示します
                
                Dim newX As Double
                newX = x2 + MIN_GAP
                
                ' 位置の更新 (注記の座標を直接操作)
                ' GetPosition/SetPosition は注記のアンカーポイントを使用
                Dim pos As Variant
                pos = targetAnn.GetPosition
                pos(0) = newX ' X座標を更新
                targetAnn.SetPosition pos
                
                ' 押し出したことで新しい境界ボックスを再計算させる必要があるが、
                ' 簡易的な実装のため、ここでは1回のみの調整とする
            End If
        Next j
    Next i

    swModel.GraphicsRedraw ' 画面更新
    MsgBox "寸法線の最適化が完了しました。", vbInformation
End Sub

3. 伝説のエンジニアが教える「陥りやすい3つの罠」

コードを書いただけでは、プロフェッショナルとは言えません。実務でこのマクロを動かした際に、必ず直面する「壁」をあらかじめ伝えておきます。

罠①:単位系のミスマッチ(Meters vs Millimeters)

SolidWorks APIの最大の特徴であり、最大の罠です。
API内部の数値はすべて「メートル」で管理されています。
「5mm動かしたい」と思って `targetAnn.SetPosition(5)` と書くと、5メートル動いてしまい、寸法が宇宙の彼方へ消え去ります。必ず `0.005` と記述するか、`5 / 1000` と計算式を入れましょう。

罠②:計算量の爆発(Complexity Issue)

上記のコードでは、全ての注記を総当たりで比較する `O(n^2)` のアルゴリズムを採用しています。
注記が100個なら $100^2 = 10,000$ 回の計算で済みますが、もし大規模なアセンブリ図面で注記が数千個になると、マクロがフリーズしたように重くなります。
「全ての注記を比較するのではなく、同じビュー内、あるいは近接する座標の注記のみを比較する」という最適化が、上級者へのステップアップです。

罠③:再帰的な衝突(Cascading Collisions)

ある寸法を右に動かした結果、今度は別の寸法とぶつかるという現象です。
これを防ぐには、一度のループで終わらせず、配置が安定するまで繰り返す(収束計算)、あるいは「一方向にのみ動かす」といったルール作りが重要になります。

4. まとめ:ここから見える景色

いかがでしたか?
単なる「記録」では絶対に到達できない、「座標を計算し、論理的に配置を決定する」という領域。これがVBAの真の面白さです。

今回のコードは、あくまで「X方向に押し出す」というシンプルなロジックですが、これを応用すれば:

  • 垂直な寸法線ならY方向に動かす
  • 重なり具合に応じて、もっと大きく引き離す
  • 特定のレイヤー(注記)だけを対象にする

といった具合に、無限の拡張性が生まれます。

「マクロは、あなたの代わりに考えるツールである」

このマインドセットを持てたとき、あなたのエンジニアリングスキルは、単なる作業者から、システムアーキテクトへと進化を遂げるはずです。

さあ、次はあなたの手で、このアルゴリズムをさらに研ぎ澄ませてみてください。応援していますよ。

タイトルとURLをコピーしました