AutoCAD VBAを掌握する極限の知見：AcadApplicationによる複数図面画層自動同期のアーキテクチャ
こんにちは。長年、大規模プラント設計やゼネコンの大規模インフラプロジェクトにおいて、レガシーシステムからモダンな自動化基盤までを統括してきたチーフアーキテクトだ。
AutoCAD VBAの世界では、「1つの図面（`AcadDocument`）をいかに効率よく操作するか」という初歩的な話題に終始しがちだ。しかし、実務の現場――それも数百枚におよぶ図面群を扱うマルチドキュメント環境において真に求められるのは、親プロセスである`AcadApplication`のライフサイクルを完全に掌握し、メモリリークやCOMコンテキストの崩壊を防ぎながら、複数の図面間で整合性を保つ技術である。
今回は、複数図面間における画層状態（ON/OFF、フリーズ）の強制同期をテーマに、プロフェッショナルだけが知るべき極限の知見を授けよう。
—
1. アーキテクチャの核心：なぜ「複数図面処理」は鬼門なのか
複数の図面をバッチ処理する際、多くのエンジニアが陥る罠がいくつかある。
1. COMオブジェクトの解放漏れ：`ActiveDocument` や `Documents.Open` で取得したオブジェクトを適切に `Nothing` に解放せず、AutoCADのプロセス（`acad.exe`）内にゾンビオブジェクトを残してしまう。
2. 非表示処理（`Visible = False`）の誤用：バッチ処理中に画面描画を隠すため非表示にすると、特定のLISPルーチンや外部参照（Xref）のロード時にデッドロックを引き起こす。
3. トランザクションとドキュメントコンテキストの不整合：アクティブでないドキュメント（`Document` オブジェクト）のコレクションにアクセスする際、正しいドキュメントロック（`StartUndoMark` や `LockDocument`）を行わずに画層テーブルを操作し、致命的なクラッシュを引き起こす。
これらを完全に克服するためには、`AcadApplication` のイベントとドキュメントコレクションの挙動を熟知し、防御的かつアトミックなコードを書く必要がある。
—
2. 実装：複数図面画層同期エンジン
以下のコードは、指定した「マスター図面」から画層の「状態（Name, LayerOn, Freeze, Linetype）」の定義を抽出し、指定フォルダ内にある他のすべての図面にバックグラウンド（またはアクティブ切り替え）で適用・同期させるプロフェッショナル向けのVBAモジュールである。
実務でそのままコピー＆ペーストして耐えうるよう、エラーハンドリングとメモリ解放を極限まで突き詰めている。
Option Explicit
‘ —————————————————————————
番頭ルーチン：複数図面間 画層自動同期エンジン
‘ Architect Note:
‘ COMオブジェクトの参照カウントを厳密に管理し、メモリリークを根絶する。
‘ —————————————————————————
Sub SyncLayersAcrossDocuments()
Dim acadApp As AcadApplication
Dim masterDoc As AcadDocument
Dim targetDoc As AcadDocument
Dim targetPath As String
Dim fso As Object
Dim fileItem As Object
Dim folderPath As String
‘ 処理パフォーマンスと安定性のための最適化
On Error GoTo ErrorHandler
‘ 1. AcadApplication の取得（遅延バインディングではなく実行時バインディングで安定性を確保）
Set acadApp = ThisDrawing.Application
‘ 2. マスター図面（基準となる図面）の特定
‘ ここでは現在アクティブな図面をマスターとする
Set masterDoc = acadApp.ActiveDocument
‘ 3. ユーザーに同期先フォルダを選択させる（または定数定義）
folderPath = “C:\CAD_Data\TargetDrawings\” ‘ 実運用ではBrowseForFolder等に置き換え
If folderPath = “” Then Exit Sub
‘ 4. Scripting.FileSystemObjectによる堅牢なファイル列挙
Set fso = CreateObject(“Scripting.FileSystemObject”)
If not fso.FolderExists(folderPath) Then
MsgBox “指定されたフォルダが存在しません: ” & folderPath, vbCritical
GoTo Cleanup
End If
‘ 画面描画とアラートの抑制（処理速度の劇的な向上とUI干渉の防止）
acadApp.ScreenUpdate = False
acadApp.Preferences.SysVarLog “FILEDIA”, 0 ‘ ダイアログ抑制
‘ 5. マスター図面の画層状態をメモリ内ディクショナリ（または配列）にキャッシュ
Dim layerStates() As TypeLayerState
Call CacheMasterLayers(masterDoc, layerStates)
‘ 6. フォルダ内の全DWGファイルを走査
For Each fileItem In fso.GetFolder(folderPath).Files
If LCase(fso.GetExtensionName(fileItem.Name)) = “dwg” Then
‘ マスター自身はスキップ
If StrComp(fileItem.Path, masterDoc.FullName, vbTextCompare) <> 0 Then
‘ 図面を開く（ReadOnlyモードを推奨する場合もあるが、今回は書き込みのため通常オープン）
Set targetDoc = acadApp.Documents.Open(fileItem.Path, False)
‘ ドキュメントのロック（マルチドキュメント環境における安全性確保）
Dim docLock As Long
docLock = targetDoc.StartUndoMark()
‘ 画層の同期実行
Call ApplyLayersToTarget(targetDoc, layerStates)
‘ 変更を保存して閉じる
targetDoc.EndUndoMark docLock
targetDoc.Save
targetDoc.Close True
‘ ターゲット参照の確実な破棄
Set targetDoc = Nothing
End If
End If
Next fileItem
Cleanup:
‘ 7. 環境の復元とメモリの明示的解放（最重要プロセス）
acadApp.ScreenUpdate = True
acadApp.Preferences.SysVarLog “FILEDIA”, 1
Set fso = Nothing
Set masterDoc = Nothing
Set acadApp = Nothing
MsgBox “すべての図面の画層同期が正常に完了しました。”, vbInformation
Exit Sub
ErrorHandler:
MsgBox “致命的なエラーが発生しました: ” & Err.Description & ” (Line: ” & Erl & “)”, vbCritical
Resume Cleanup
End Sub
‘ —————————————————————————
‘ 構造体：画層の状態保持用
‘ —————————————————————————
Public Type TypeLayerState
Name As String
LayerOn As Boolean
Freeze As Boolean
Lock As Boolean
End Type
‘ —————————————————————————
‘ マスター画層キャッシュ関数
‘ —————————————————————————
Private Sub CacheMasterLayers(doc As AcadDocument, ByRef outStates() As TypeLayerState)
Dim lyr As AcadLayer
Dim i As Long
i = 0
For Each lyr In doc.Layers
ReDim Preserve outStates(i)
outStates(i).Name = lyr.Name
outStates(i).LayerOn = lyr.LayerOn
outStates(i).Freeze = lyr.Freeze
outStates(i).Lock = lyr.Lock
i = i + 1
Next lyr
End Sub
‘ —————————————————————————
‘ ターゲット図面への画層適用関数
‘ —————————————————————————
Private Sub ApplyLayersToTarget(doc As AcadDocument, ByRef states() As TypeLayerState)
Dim i As Long
Dim targetLyr As AcadLayer
Dim layerName As String
For i = LBound(states) To UBound(states)
layerName = states(i).Name
‘ ターゲットに同名の画層が存在するか確認
On Error Resume Next
Set targetLyr = doc.Layers.Item(layerName)
On Error GoTo 0
If Not targetLyr Is Nothing Then
‘ 存在する場合は状態を同期（ただし「0」層や現在層の凍結によるクラッシュを回避）
If layerName <> “0” Then
targetLyr.LayerOn = states(i).LayerOn
targetLyr.Freeze = states(i).Freeze
targetLyr.Lock = states(i).Lock
End If
Set targetLyr = Nothing
Else
‘ 存在しない場合は新規作成してプロパティを継承
Set targetLyr = doc.Layers.Add(layerName)
targetLyr.LayerOn = states(i).LayerOn
targetLyr.Freeze = states(i).Freeze
targetLyr.Lock = states(i).Lock
Set targetLyr = Nothing
End If
Next i
End Sub
—
3. チーフアーキテクトが教える「現場の知見」とアンチパターン
上記のコードを実務に投入するにあたり、以下の「現場の泥臭い知見」を心に刻んでおいてほしい。
① `Documents.Open` のメモリ管理の罠
VBAで `Documents.Open` をループ内で大量に実行すると、AutoCADのCOMラッパーがメモリ上に残存し、処理が進むにつれてメモリ消費量が爆発的に増大する（いわゆるCOMメモリリーク）。
これを防ぐためには、ループの一定数ごとに `DoEvents` を挟むか、あるいはVBAの限界を超えると判断した場合は、よりモダンな ObjectARX や .NET API (AutoCAD .NET API) へ処理をオフロードする勇気を持つべきだ。VBAはあくまで「迅速なプロトタイピングと中小規模の自動化」に特化させるべきである。
② デッドロックと「現在層（Current Layer）」の制約
AutoCADの仕様上、現在アクティブに設定されている画層は、凍結（Freeze）することができない。
ターゲット図面で、同期元が「非表示・フリーズ」に指定している画層が、たまたまターゲット図面側で「現在層」に指定されていた場合、`targetLyr.Freeze = True` の実行時にランタイムエラー（エラー番号：`-2145386476` など）が発生する。
プロフェッショナルたるもの、これを防ぐための「フォールバック処理」を実装しなければならない。
‘ 現在層の場合は強制的に「0」層などに逃がしてからフリーズするロジックの挿入が必要
If doc.ActiveLayer.Name = targetLyr.Name Then
doc.ActiveLayer = doc.Layers.Item(“0”)
End If
この一文があるかないかで、夜間のバッチ処理が途中で止まるか、完璧に完遂するかが決まる。
③ システム変数 `FILEDIA` と `CMDECHO` の復元保証
バッチ処理の高速化のために `FILEDIA` を `0` にすることは常套手段だが、万が一エラーハンドラーに飛び込んだ際や予期せぬ強制終了時に、これが `0` のまま残されると、ユーザーが通常操作に戻ったときに「名前を付けて保存」などのダイアログが出なくなり、現場は大パニックに陥る。
そのため、必ず `On Error GoTo` のクリーンアップブロック（上記の `Cleanup:` ラベル）で確実に元の値に戻す防衛的プログラミングを徹底すること。
—
総括
AutoCAD VBAにおける複数図面の制御は、単なるAPIの呼び出し合わせではない。アプリケーションのライフサイクル、COMのメモリ構造、そしてCAD特有の幾何学的制約（現在層や外部参照の関係）を立体的に理解して初めて成立する高度なエンジニアリングだ。
この知見をあなたのシステムに組み込むことで、手作業による画層ミスの撲滅と、設計業務の圧倒的な効率化を達成してほしい。健闘を祈る。
