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

SolidWorks VBA

2026.11.03

「スクリプト」で終わらせるな、「ツール」を設計せよ：SolidWorks図面レイヤー自動制御の極致

「スクリプト」で終わらせるな、「ツール」を設計せよ：SolidWorks図面レイヤー自動制御の極致

エンジニアリングの現場において、「動けばいい」という思考はもっとも危険な毒である。

多くの開発者が、SolidWorks VBAを使い始めて最初に直面する壁が、図面（Drawing）の整理整頓だ。寸法、中心線、注釈……これらが適切なレイヤーに割り当てられていない図面は、後工程の検図者や製造担当者にとって「情報のゴミ溜め」に等しい。

本記事では、単に「レイヤーを切り替える」だけの初歩的なマクロではない。「設計思想に基づいた、堅牢で、パフォーマンスを考慮した、プロダクションレベルのレイヤー振り分けエンジン」の構築方法を伝授する。

1. アーキテクトの視点：なぜ、あなたのマクロは遅いのか？

多くの初心者が書くコードは、`Select` メソッドを多用し、オブジェクトの階層を力技で辿る。
「現在のビューを選択し、その中の要素を一つずつループで回し、種類を判定して……」
このアプローチは、要素数が増えた瞬間に計算量が指数関数的に増大し、SolidWorksをフリーズさせる。

オブジェクトのライフサイクルとAPIコスト

SolidWorks APIにおいて、最もコストが高いのは「COMオブジェクトへのアクセス」と「描画の更新（Redraw）」だ。
ループの中で `swModel.GraphicsRedraw` を呼び出したり、都度 `SelectByID2` を実行したりするのは、エンジニアとして恥ずべき行為である。

プロフェッショナルが目指すべきは、「Annotation（注釈）オブジェクトを直接、最短経路で走査する」設計である。

2. 設計指針：堅牢なレイヤー制御エンジン

図面内の要素をレイヤーに振り分ける際、以下の3つの設計原則を遵守せよ。

1. Idempotency（冪等性）の確保:
レイヤーが存在しない場合にエラーを吐くのではなく、自動的に生成、あるいは既存のレイヤーを使用する設計にすること。
2. Type-Safeな判定:
`TypeName` などの文字列比較に頼るな。`swAnnotationType_e` 列挙型（Enum）を使い、型安全に判定せよ。
3. Single Responsibility Principle（単一責任の原則）:
「レイヤーを作る関数」「要素を判定する関数」「要素にレイヤーを適用する関数」を分離せよ。

3. プロダクションコード：LayerAssignmentEngine

以下に、実務でそのまま利用可能なレベルのコードを示す。このコードは、図面内のすべての注釈（Annotation）をスキャンし、その種類に基づいて定義済みのレイヤーへ高速に割り当てる。

'**
' Module: DrawingLayerManager
' Description: 図面内の注釈を種類別に特定のレイヤーへ自動配分する
' Author: Chief Architect
'**

Option Explicit

' レイヤー名の定数定義（本来は外部設定ファイルやExcelから読み込むべき）
Private Const LAYER_DIMENSION As String = "DIM_Layer"
Private Const LAYER_CENTERLINE As String = "CENTER_Layer"
Private Const LAYER_ANNOTATION As String = "NOTE_Layer"
Private Const LAYER_DEFAULT As String = "None"

Sub Main()
    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim swDraw As SldWorks.DrawingDoc
    
    On Error GoTo ErrorHandler

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc

    ' 1. ドキュメント型のバリデーション
    If swModel Is Nothing Then
        MsgBox "ドキュメントが開かれていません。", vbCritical
        Exit Sub
    End If

    If swModel.GetType <> swDocDRAWING Then
        MsgBox "図面ファイル（Drawing）を開いてください。", vbCritical
        Exit Sub
    End If

    Set swDraw = swModel
    
    ' 描画更新の停止（パフォーマンス向上のための鉄則）
    swModel.LockGraphics = True

    ' 2. 必要なレイヤーの事前準備（冪等性の確保）
    PrepareLayers swDraw

    ' 3. 注釈の走査と振り分け実行
    ProcessDrawingAnnotations swDraw, swModel

    ' 4. 描画更新の再開
    swModel.LockGraphics = False
    swModel.GraphicsRedraw

    MsgBox "レイヤーの再配置が完了しました。", vbInformation
    Exit Sub

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

''' <summary>
''' 図面内の注釈を走査し、種類に応じてレイヤーを割り当てる
''' </summary>
Private Sub ProcessDrawingAnnotations(swDraw As SldWorks.DrawingDoc, swModel As SldWorks.ModelDoc2)
    Dim swSheet As SldWorks.Sheet
    Dim swView As SldWorks.View
    Dim swAnn As SldWorks.Annotation
    Dim targetLayer As String
    
    ' 全てのシートをループ
    Set swView = swDraw.GetFirstView ' Sheet自体が最初のViewとして取得される
    
    Do While Not swView Is Nothing
        ' 各ビュー内の注釈を取得
        ' 注釈はViewオブジェクトに紐付いている
        Set swAnn = swView.GetFirstAnnotation
        
        Do While Not swAnn Is Nothing
            ' 注釈の型に基づいてターゲットレイヤーを決定
            targetLayer = DetermineLayerByType(swAnn.GetType)
            
            ' レイヤー割り当ての実行
            If targetLayer <> LAYER_DEFAULT Then
                swAnn.Layer = targetLayer
            End If
            
            ' 次の注釈へ
            Set swAnn = swAnn.GetNext
        Loop
        
        ' 次のビューへ
        Set swView = swView.GetNextView
    Loop
End Sub

''' <summary>
''' 注釈の型(swAnnotationType_e)から、割り当てるべきレイヤー名を返す
''' </summary>
Private Function DetermineLayerByType(annType As Long) As String
    Select Case annType
        Case swAnnotationType_e.swAnnotationType_Dimension
            DetermineLayerByType = LAYER_DIMENSION
        Case swAnnotationType_e.swAnnotationType_Centerline
            DetermineLayerByType = LAYER_CENTERLINE
        Case swAnnotationType_e.swAnnotationType_Note, _
             swAnnotationType_e.swAnnotationType_Balloon
            DetermineLayerByType = LAYER_ANNOTATION
        Case Else
            DetermineLayerByType = LAYER_DEFAULT
    End Select
End Function

''' <summary>
''' 指定されたレイヤーが存在しない場合、新規作成する
''' </summary>
Private Sub PrepareLayers(swDraw As SldWorks.DrawingDoc)
    Dim layerNames As Variant
    Dim i As Integer
    Dim swLayer As SldWorks.Layer
    
    ' 作成すべきレイヤーリスト
    layerNames = Array(LAYER_DIMENSION, LAYER_CENTERLINE, LAYER_ANNOTATION)
    
    For i = LBound(layerNames) To UBound(layerNames)
        ' レイヤーが存在するか確認（存在しない場合のみAddLayer）
        ' GetLayerは存在しない場合にNothingを返す
        Set swLayer = swDraw.GetLayer(CStr(layerNames(i)))
        
        If swLayer Is Nothing Then
            swDraw.AddLayer CStr(layerNames(i))
        End If
    Next i
End Sub

4. 実務への展開：データベース・外部連携の勘所

上記のコードは「スタンドアロン」として動作するが、真に業務効率化を極めるなら、レイヤー定義をコード内にハードコードしてはならない。

外部設定ファイル（Excel/JSON/CSV）との連携

社内規定が変わるたびにVBAコードを書き換えるのは、保守性の観点から見て最悪の設計だ。
実務レベルのツールでは、以下の構成を推奨する。

1. Configファイル（Excel）の作成:
`[AnnotationType] | [TargetLayerName]` というマッピングテーブルを持つ。
2. マクロ起動時のロード:
マクロ開始時にExcelをバックグラウンドで開き、Dictionaryオブジェクトにマッピング情報を格納する。
3. 動的な判定:
`DetermineLayerByType` 関数は、Dictionaryを参照してレイヤー名を返すように変更する。

これにより、現場の管理者がExcelを書き換えるだけで、エンジニアの手を借りずにマクロの挙動（ルール）をアップデートできる。これが「ツール」と「スクリプト」の決定的な差である。

5. まとめ：エンジニアとしての矜持

今回紹介した手法の肝は、「描画更新の制御（LockGraphics）」「型安全な判定（Enum）」「冪等性の担保（PrepareLayers）」の3点に集約される。

これらを意識せずに書かれたコードは、一時的な便利さは提供するが、長期的にはシステムの不安定化や、予期せぬバグによる工数増大を招く。

「なぜこの書き方なのか？」
常にその問いを自分に投げかけ、オブジェクトの挙動を深く洞察せよ。それが、伝説的なアーキテクトへの第一歩である。