図面の秩序を統制せよ：SolidWorksにおけるアノテーション・レイヤー自動割当の極限設計
図面（Drawing）は、単なる設計情報の視覚化ではない。それは、製造、検査、そしてPLM（Product Lifecycle Management）システムへと流れる構造化されたデータである。
多くのエンジニアは、図面内の寸法や中心線が「ただそこにある」ことを許容している。しかし、大規模なプロジェクトにおいて、レイヤー管理がなされていない図面は、後続の自動検図システムや、画像解析を用いた品質管理プロセスにおいて、ノイズの塊へと成り下がる。
本稿では、単なる「レイヤー変更マクロ」ではない。オブジェクトのライフサイクル、メモリの整合性、そして大規模データ処理におけるパフォーマンスを極限まで考慮した、エンタープライズ級の図面整理アーキテクチャを提示する。
1. 凡庸な実装が陥る「COMオブジェクトの泥沼」
一般的な技術ブログでは、`SelectionMgr` を用いて要素を選択し、プロパティを書き換える手法が紹介される。しかし、数千の寸法を持つ大規模図面において、その手法は致命的な欠陥を露呈する。
1. パフォーマンスの劣化: `SelectByID2` などの選択操作は、SolidWorksの内部的な再描画（Redraw）を誘発し、計算コストを爆発させる。
2. メモリリーク: VBAのCOMインターフェースは、オブジェクトの参照カウントを厳格に管理しなければならない。ループ内でオブジェクトを適切に解放（`Set = Nothing`）しない場合、SolidWorksのプロセスはメモリを食いつぶし、最終的に「応答なし」へと陥る。
3. 非決定的な動作: 選択状態に依存するコードは、ユーザーの操作一つで実行結果が変わり得る。プロフェッショナルなツールには、「状態に依存しない（Stateless）」な走査ロジックが求められる。
我々が目指すのは、図面ツリーを直接走査（Traversal）し、各オブジェクトの型を判定して、直接プロパティを書き換える決定論的なアプローチである。
2. 実装の核心：階層的走査アルゴリズム
図面におけるアノテーションの構造は、以下の階層を形成している。
`DrawingDoc` $\rightarrow$ `Sheet` $\rightarrow$ `View` $\rightarrow$ `Annotation` $\rightarrow$ `Dimension / Note / Centerline`
この階層を、`GetFirstAnnotation2` と `GetNextAnnotation2` を用いて、選択操作を一切介さずに辿るのが正解である。
高度な実装における設計指針
- レイヤーの事前検証: ターゲットとなるレイヤーが存在しない場合、エラーで止まるのではなく、動的に生成するか、ログに記録してスキップする堅牢性を持たせる。
- Windows APIによるUI制御: 大規模処理中は、ユーザーによる不必要な操作を防ぐため、カーソルを待機状態（Busy）にする。
- 明示的解放: ループの各ステップにおいて、インターフェースへのポインタを確実に解放する。
3. 究極のコード・プロトタイプ
以下に、シニアエンジニアが実戦投入することを想定した、堅牢なVBAモジュールを示す。
Option Explicit
' Windows API: カーソルの制御
Private Declare PtrSafe Sub User32_SetCursor (ByVal hCursor As LongPtr)
Private Declare PtrSafe Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As LongPtr, ByVal lpCursorName As Long) As LongPtr
' 定数定義: レイヤー名
Private Const LAYER_DIMENSION As String = "DIM_LAYER"
Private Const LAYER_CENTERLINE As String = "CL_LAYER"
Private Const LAYER_NOTE As String = "NOTE_LAYER"
' 定数定義: カーソル
Private Const IDC_WAIT As Long = 32650
''' <summary>
''' 図面内の全アノテーションを走査し、種類に応じてレイヤーを自動割当する
''' </summary>
Public Sub OrganizeDrawingLayers()
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 swDim As SldWorks.Dimension
Dim swNote As SldWorks.Note
Dim swCL As SldWorks.Centerline
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
' Windows APIで待機カーソルを表示
User32_SetCursor LoadCursor(0, IDC_WAIT)
' 高速化のため描画更新を停止
swModel.ActiveView.EnableGraphicsUpdate = False
' 2. レイヤーの存在確認と生成 (抽象化されたロジック)
EnsureLayersExist swDraw
' 3. 図面走査の開始
' 全シートをループ
Dim sheetNames As Variant
Dim i As Integer
sheetNames = swDraw.GetSheetNames
For i = 0 To UBound(sheetNames)
swDraw.ActivateSheet sheetNames(i)
Set swSheet = swDraw.GetCurrentSheet
' シート内の各ビューを走査
' GetFirstViewはシートそのものを指すため、次のViewから開始
Set swView = swDraw.GetFirstView
Do While Not swView Is Nothing
' ビュー内のアノテーションを走査
Set swAnn = swView.GetFirstAnnotation2
Do While Not swAnn Is Nothing
' アノテーションの型に基づいた分岐
' 注: Annotationオブジェクトは、DimensionやNoteの親インターフェースである
Select Case swAnn.GetType
Case swAnnotationType_e.swAnnotationType_Dimension
Set swDim = swAnn.GetSpecificAnnotation
swAnn.Layer = LAYER_DIMENSION
Case swAnnotationType_e.swAnnotationType_Note
Set swNote = swAnn.GetSpecificAnnotation
swAnn.Layer = LAYER_NOTE
Case swAnnotationType_e.swAnnotationType_Centerline
Set swCL = swAnn.GetSpecificAnnotation
swAnn.Layer = LAYER_CENTERLINE
' 必要に応じて他の型（Leader, Wipeout等）を追加
End Select
' 重要: 次のアノテーションを取得する前に、現在の参照を切り離す
' これにより、COMの参照カウントが適切に管理される
Set swAnn = swAnn.GetNextAnnotation2
Loop
' 次のビューへ
Set swView = swView.GetNextView
Loop
Next i
' 4. 後処理
swModel.ForceRebuild3 True
swModel.ActiveView.EnableGraphicsUpdate = True
MsgBox "レイヤーの整理が完了しました。", vbInformation
CleanExit:
' メモリの明示的解放
Set swCL = Nothing
Set swNote = Nothing
Set swDim = Nothing
Set swAnn = Nothing
Set swView = Nothing
Set swSheet = Nothing
Set swDraw = Nothing
Set swModel = Nothing
Set swApp = Nothing
Exit Sub
ErrorHandler:
MsgBox "致命的なエラーが発生しました: " & Err.Description, vbCritical
Resume CleanExit
End Sub
''' <summary>
''' 指定されたレイヤーが存在しない場合、新規作成する
''' </summary>
Private Sub EnsureLayersExist(ByRef swDraw As SldWorks.DrawingDoc)
Dim layerNames As Variant
Dim name As Variant
Dim swLayer As SldWorks.Layer
layerNames = Array(LAYER_DIMENSION, LAYER_CENTERLINE, LAYER_NOTE)
For Each name In layerNames
' レイヤーが存在するか確認し、なければ作成
' ※実際の実装では、既存レイヤーの取得ロジックをここに内包させる
' SolidWorks APIのLayer管理は、DrawingDocのメソッド経由で行う
Set swLayer = swDraw.GetLayer(CStr(name))
If swLayer Is Nothing Then
swDraw.CreateLayer CStr(name)
End If
Next name
End Sub4. アーキテクトの視点：運用における極限の知見
このコードを単なるスクリプトとして終わらせてはいけない。システムの一部として運用するための、3つの鉄則を授ける。
I. 決定論的なエラーハンドリング
大規模な自動化プロセスにおいて、`On Error Resume Next` は「悪」である。エラーを無視することは、データの整合性を破壊することを意味する。本コードのように、`ErrorHandler` を設け、エラー発生時には必ず `CleanExit` を経由して、オブジェクトの解放と描画更新の再開（EnableGraphicsUpdate = True）を保証しなければならない。これを怠ると、マクロがクラッシュした際にSolidWorksが描画不能に陥る。
II. 冪等性（Idempotency）の確保
このマクロを、同じ図面に対して、あるいは既に整理済みの図面に対して、何度実行しても結果が変わらない（副作用が同じである）状態、すなわち「冪等性」を確保せよ。`EnsureLayersExist` の実装がその鍵となる。
III. レガシー環境への配慮
社内システムでは、古いバージョンのSolidWorksや、32bit/64bit混在環境が残っていることが多い。`PtrSafe` キーワードを用いた Windows API の宣言、および `LongPtr` 型の適切な使用は、これからのエンジニアにとって必須の素養である。
結論
図面の整理は、単なる「清掃」ではない。それは、設計データを「計算可能な資産」へと昇華させるプロセスである。
オブジェクトの階層を理解し、メモリの振る舞いを制御し、堅牢なエラーハンドリングを実装する。それこそが、単なる「マクロ使い」と、真の「自動化アーキテクト」を分かつ境界線である。
