【実務・中級編】【中級者向け】図面内の特定レイヤーに対して寸法やアノテーションを自動振り分けするVBAマクロ – SolidWorks VBA解析バイブル

凡庸なスクリプトを脱却せよ：SolidWorks図面における「レイヤー自動割当」の設計思想と極限の実装

「図面内の寸法をすべて『DIM』レイヤーに移す」――そんな単純な指示だけでコードを書き始めていないだろうか？

もし君が、`SelectByID2` をループの中で乱用し、オブジェクトの型判定を場当たり的な `If` 文の羅列で済ませているとしたら、そのツールは「業務効率化ツール」ではなく、単なる「バグの温床」だ。大規模な図面、あるいは数千個のアノテーションを持つ複雑なアセンブリ図面において、その非効率なコードはSolidWorksをフリーズさせ、ユーザーの信頼を失墜させる。

プロフェッショナルなエンジニアに求められるのは、単なる自動化ではない。「計算量を意識したオブジェクト走査」と「拡張性の高い設計思想」である。

本記事では、図面内の寸法、中心線、注記を判別し、定義されたルールに基づいて一括でレイヤーへ割り振る、プロダクションレベルの堅牢なマクロの設計術を伝授する。

1. アーキテクチャの設計：なぜ「型判定」が重要なのか

図面（Drawing）におけるアノテーション（寸法、注記、中心線など）は、すべて `Annotation` オブジェクト という共通の基盤を持っている。しかし、実務では「寸法はレイヤーA」「注記はレイヤーB」といった、要素ごとの振る舞いの違いが求められる。

ここで初心者が陥る罠が、`SelectionMgr` を使って「選択しながら処理する」手法だ。これは極めて遅い。
我々が目指すべきは、「図面内の全アノテーションを列挙（Enumerate）し、その型（Type）に基づいて、あらかじめ定義したマッピング・ルールに従ってレイヤーを適用する」という、宣言的なアプローチである。

設計の3原則

1. Layer Existence Guarantee (レイヤー存在保証): 存在しないレイヤーを指定してエラーで落ちるような設計は論外。事前にレイヤーの存在を確認し、なければ作成するロジックを組み込む。
2. Complexity Control (計算量の制御): `SelectByID2` は使わない。APIのリファレンスを辿り、オブジェクトの階層を直接辿る。
3. Decoupling (疎結合): 「どの要素をどのレイヤーにするか」というルール（データ）と、「どうやってレイヤーを書き換えるか」というロジック（コード）を分離する。

2. プロダクションコード：堅牢なレイヤー管理エンジン

以下に、実務でそのまま利用可能なレベルのコードを示す。単なるコピペで終わらせず、各モジュールの意図を読み解いてほしい。

Option Explicit

' ==============================================================================
' 構成定義: 要素タイプとレイヤー名のマッピング
' 実務ではここを外部のCSVや設定ファイルから読み込むように拡張するのが定石だ。
' ==============================================================================
Private Enum AnnotationTypeMap
    mapDimension = swAnnotationType_e.swAnnotationType_Dimension
    mapNote = swAnnotationType_e.swAnnotationType_Note
    mapCenterline = swAnnotationType_e.swAnnotationType_Centerline
    mapLeader = swAnnotationType_e.swAnnotationType_Leader
End Enum

' ==============================================================================
' メインルーチン
' ==============================================================================
Public Sub SmartLayerAssigner()
    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 swDisplayData As SldWorks.DisplayData
    
    On Error GoTo ErrorHandler

    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.ActiveView.EnableGraphicsUpdate = False
    
    ' 2. レイヤーの事前準備（存在しない場合は自動生成）
    PrepareLayers swDraw
    
    ' 3. 図面内の全ビューを走査
    ' 第一ビュー（シートそのもの）から始まり、各ビュー内のアノテーションを辿る
    Set swView = swDraw.GetFirstView ' Sheet View
    
    Do While Not swView Is Nothing
        ' 各ビューに属するアノテーションを走査
        ' GetFirstAnnotation はビュー内の最初の要素を返す
        Set swAnn = swView.GetFirstAnnotation
        
        Do While Not swAnn Is Nothing
            ' アノテーションの属性に基づき、適切なレイヤーを割り当てる
            ApplyLayerByAnnotationType swAnn
            
            ' 次のアノテーションへ
            Set swAnn = swAnn.GetNext
        Loop
        
        ' 次のビューへ
        Set swView = swView.GetNextView
    Loop

    ' 画面更新を再開
    swModel.ActiveView.EnableGraphicsUpdate = True
    swModel.ForceRebuild3 True
    
    MsgBox "レイヤーの自動割り当てが完了しました。", vbInformation
    Exit Sub

ErrorHandler:
    swModel.ActiveView.EnableGraphicsUpdate = True
    MsgBox "致命的なエラーが発生しました: " & Err.Description, vbCritical
End Sub

' ==============================================================================
' サブルーチン: アノテーションの型に基づいたレイヤー適用
' ==============================================================================
Private Sub ApplyLayerByAnnotationType(ByRef swAnn As SldWorks.Annotation)
    Dim layerName As String
    Dim annType As Long
    
    annType = swAnn.GetType
    
    ' 型判定ロジック（ここでルールを管理する）
    Select Case annType
        Case mapDimension
            layerName = "DIM_Layer"
        Case mapNote, mapLeader
            layerName = "NOTE_Layer"
        Case mapCenterline
            layerName = "CENTER_Layer"
        Case Else
            ' 定義外のタイプはスキップ、あるいはデフォルトレイヤーへ
            Exit Sub
    End Select
    
    ' レイヤーの適用
    swAnn.Layer = layerName
End Sub

' ==============================================================================
' サブルーチン: レイヤーの存在確認と自動生成
' ==============================================================================
Private Sub PrepareLayers(ByRef swDraw As SldWorks.DrawingDoc)
    Dim layerNames As Variant
    Dim i As Integer
    Dim swLayerMgr As SldWorks.LayerManager
    
    ' 必要なレイヤー名のリスト
    layerNames = Array("DIM_Layer", "NOTE_Layer", "CENTER_Layer")
    
    Set swLayerMgr = swDraw.GetLayerManager
    
    For i = LBound(layerNames) To UBound(layerNames)
        ' レイヤーが存在するか確認。存在しない場合は作成。
        ' ※本来は色や線種もここで定義すべきだが、簡略化している。
        If swLayerMgr.GetLayer(CStr(layerNames(i))) Is Nothing Then
            swLayerMgr.CreateLayer CStr(layerNames(i)), "", 0, 0, 0 ' 色指定は必要に応じて
        End If
    Next i
End Sub

3. 技術的解説：なぜこのコードは「強い」のか

① 走査アルゴリズムの最適化

多くの開発者は `swModel.SelectionManager` を使って「画面上で選択されているもの」を処理しようとする。しかし、本コードは `swView.GetFirstAnnotation` から始まるツリー走査を採用している。これにより、ユーザーが何も選択していなくても、図面全体の要素を漏れなく、かつ高速にスキャンできる。

② 計算量の最小化：`EnableGraphicsUpdate` の重要性

ループ内でオブジェクトのプロパティ（特にレイヤー）を変更するたびに、SolidWorksは画面の再描画（Redraw）を試みる。数千の寸法がある図面でこれをやると、計算時間は指数関数的に増大する。`swModel.ActiveView.EnableGraphicsUpdate = False` を冒頭で叩き込み、最後に一括で `ForceRebuild3` を行う。これだけで、処理速度は数倍から数十倍変わる。

③ 堅牢なエラーハンドリングと事前準備

`PrepareLayers` サブルーチンに注目してほしい。実務において「レイヤーがないからエラーで止まる」マクロは使い物にならない。コードが「図面の標準状態」を自ら作り出す（レイヤーを自動生成する）ことで、実行環境に依存しない自己完結型のツールとなっている。

4. 次のステップ：さらなる高みへ

このコードは、あくまで「基盤」だ。実務のリーダーとして、君には次の拡張を検討してほしい。

• データベース連携: レイヤー名と色のマッピングをExcelや外部JSONファイルから読み込むようにし、コードを一切書き換えずに「図面規格の変更」に対応できるようにする。
• DisplayDataの制御: レイヤー変更だけでなく、線の太さ（Line Weight）や色を `swAnn.SetDisplayData` を通じて制御し、視覚的な品質をさらに高める。
• 例外処理の精緻化: 特定のビュー（例：注記のみを配置する専用ビュー）を除外するフィルタリングロジックの実装。

自動化の本質は、コードを書くことではない。「ルールを構造化し、人間が介入すべきでない領域を完全に封じ込めること」にある。

健闘を祈る。