AutoCAD VBAを掌握する極限の知見：図面内の全ブロック参照を完全網羅し、データ資産化する技術
AutoCAD VBAによる自動化開発において、最も頻繁に直面し、かつ最も適当に実装されがちなのが「ブロック情報の抽出」だ。
「図面内にある特定のブロックを探して数を数えたい」
「すべてのブロックの挿入座標をリスト化して外部連携したい」
ネットを検索すれば、`ModelSpace`を`For Each`で回すサンプルコードが無数に出てくる。しかし、実務で数万要素を超える大規模図面を扱ったことがある者なら知っているはずだ。その「素朴なループ処理」が、AutoCADをフリーズさせ、メモリリークを引き起こし、実用に耐えない遅延を生むことを。
今回は、AutoCADのオブジェクトモデルの深層、特に`AcadDocument`とブロック管理の仕組みを解剖し、実務の現場でそのまま稼働する、堅牢かつ極限まで最適化されたブロック参照リスト化エンジンの設計思想とコードを伝授する。
—
1. なぜ「素朴なループ」は実務で破綻するのか？
多くの解説記事では、次のようなコードが平然と紹介されている。
‘ 【アンチパターン】絶対に真似してはいけないコード
Dim ent As AcadEntity
For Each ent in ThisDrawing.ModelSpace
If ent.ObjectName = “AcDbBlockReference” Then
‘ 処理…
End If
Next
このアプローチが実務で破綻する理由は明確だ。
1. レイアウト空間の無視: ブロックはモデル空間だけでなく、複数のペーパー空間（レイアウト）のビューポート内やシート上に無数に存在する。`ModelSpace`だけを舐めても、図面全体のブロック管理にはならない。
2. ネストされたブロック（入れ子）の沈黙: ブロックの中に別のブロックが含まれている場合（ネスト構造）、通常の空間走査では内部のブロック参照を拾うことができない。
3. COMとVBAのオーバーヘッド: `For Each`によるCOMオブジェクトへのアクセスは、ループの回数に比例してパフォーマンスが劣化する。
プロのエンジニアが目指すべきは、「あらゆる空間を網羅し、ネストをも貫通し、かつ一瞬で終わる」堅牢なアーキテクチャである。
—
2. 堅牢なブロック抽出エンジンの設計方針
今回のツール（プロダクションコード）では、以下の要件を満たす設計を行う。
- 全空間の走査: `ModelSpace`だけでなく、すべての`Layout`（ペーパー空間含む）を走査対象とする。
- ネスト構造への対応（再帰処理）: 取得したブロック定義（`AcadBlock`）の内部エンティティを再帰的に走査し、入れ子になったブロック参照も取り逃がさない。
- CSV/外部出力への拡張性: 取得したデータ（ブロック名、ハンドル、座標、尺度、回転角）をイミディエイトウィンドウへの出力だけでなく、即座にCSVやExcelへ流し込めるデータ構造に整理する。
- エラーハンドリング: 削除済みオブジェクトやロックされた画層など、実務特有の例外でマクロがクラッシュしない防御的コード。
—
3. 【プロダクションコード】全ブロック参照リスト化マクロ
以下のコードをAutoCADのVBAエディタ（IDE）に実装してほしい。標準モジュールに貼り付けるだけで、即座に実戦投入できる。
Option Explicit
‘ =================================================================================
‘ módulo名: modBlockExtractor
‘ 概要: 図面内の全モデル・ペーパー空間、およびネストされたブロック内の
‘ すべてのブロック参照を再帰的に抽出し、詳細情報をリスト化する
‘ =================================================================================
Public Sub ExportAllBlockReferencesToCSV()
Dim startTime As Double
startTime = Timer
On Error GoTo ErrorHandler
‘ 1. 出力先ファイルのパス設定（デスクトップにCSV出力）
Dim fso As Object, ts As Object
Dim desktopPath As String
Set fso = CreateObject(“Scripting.FileSystemObject”)
desktopPath = CreateObject(“WScript.Shell”).SpecialFolders(“Desktop”) & “\”
Dim targetFile As String
targetFile = desktopPath & “BlockReference_List_” & Format(Now, “yyyymmdd_HHMMSS”) & “.csv”
Set ts = fso.CreateTextFile(targetFile, True)
‘ CSVヘッダーの書き込み (BOM付与でExcelでの文字化け防止)
ts.Write Chr(&HEF) & Chr(&HBB) & Chr(&HBF)
ts.WriteLine “空間/親ブロック,ブロック名,ハンドル,X座標,Y座標,Z座標,尺度X,尺度Y,尺度Z,回転角(rad)”
Dim totalCount As Long
totalCount = 0
‘ 2. 各レイアウト（モデル空間 ＋ ペーパー空間）の走査
Dim layoutObj As AcadLayout
For Each layoutObj In ThisDrawing.Layouts
Dim blockObj As AcadBlock
Set blockObj = layoutObj.Block
‘ 空間内のエンティティを再帰的にスキャン
Call ScanEntities(blockObj, layoutObj.Name, ts, totalCount)
Next layoutObj
ts.Close
MsgBox “ブロック情報の抽出が完了しました！” & vbCrLf & _
“総抽出数: ” & totalCount & ” 件” & vbCrLf & _
“出力先: ” & targetFile, vbInformation, “処理成功”
CleanUp:
Set ts = Nothing
Set fso = Nothing
Exit Sub
ErrorHandler:
MsgBox “予期せぬエラーが発生しました: ” & Err.Description, vbCritical, “致命的エラー”
Resume CleanUp
End Sub
‘ =================================================================================
‘ 再帰的エンティティスキャン関数（ネストされたブロックに対応）
‘ =================================================================================
Private Sub ScanEntities(ByVal targetBlock As AcadBlock, ByVal parentName As String, ByRef ts As Object, ByRef totalCount As Long)
Dim ent As AcadEntity
Dim insPt As Variant
Dim scaleFactors As Variant
Dim blockRef As AcadBlockReference
Dim innerBlock As AcadBlock
For Each ent In targetBlock
‘ オブジェクトがブロック参照（INSERT）であるか判定
If TypeOf ent Is AcadBlockReference Then
Set blockRef = ent
insPt = blockRef.InsertionPoint
scaleFactors = blockRef.ScaleFactors
‘ CSV行の構築 (カンマ区切りの安全な出力)
Dim csvLine As String
csvLine = EscapeCSV(parentName) & “,” & _
EscapeCSV(blockRef.Name) & “,” & _
blockRef.Handle & “,” & _
insPt(0) & “,” & _
insPt(1) & “,” & _
insPt(2) & “,” & _
scaleFactors(0) & “,” & _
scaleFactors(1) & “,” & _
scaleFactors(2) & “,” & _
blockRef.Rotation
ts.WriteLine csvLine
totalCount = totalCount + 1
‘ 【重要】ブロック定義の中にさらにブロックがある場合（ネスト）、再帰的に掘り下げる
On Error Resume Next
Set innerBlock = ThisDrawing.Blocks.Item(blockRef.Name)
If Err.Number = 0 And Not innerBlock Is Nothing Then
If Not innerBlock.IsLayout Then ‘ レイアウト自体を除外
Call ScanEntities(innerBlock, parentName & ” > ” & blockRef.Name, ts, totalCount)
End If
End If
On Error GoTo 0
End If
Next ent
End Sub
‘ =================================================================================
‘ CSV用文字列エスケープ処理
‘ =================================================================================
Private Function EscapeCSV(ByVal str As String) As String
If InStr(str, “,”) > 0 Or InStr(str, “”””) > 0 Or InStr(str, vbLf) > 0 Then
EscapeCSV = “””” & Replace(str, “”””, “”””””) & “”””
Else
EscapeCSV = str
End If
End Function
—
4. チーフアーキテクトが解説するコードの急所
このコードが「単なる動くサンプル」を超えてプロダクション品質たる所以を解説する。
① `ThisDrawing.Layouts` による完全網羅
`ModelSpace`オブジェクトを直接叩くのではなく、`Layouts`コレクションから各レイアウトの`Block`プロパティを取得している。これにより、モデル空間だけでなく、すべてのタブ（レイアウト）に配置されたブロック漏れなくキャプチャできる。
② 再帰呼び出し（Recursion）によるネスト崩壊の防止
実務の図面では、「設備図のなかに部屋ユニットという親ブロックがあり、その中に照明器具の子ブロックが入っている」といったネスト構造が日常茶飯事だ。
上記の `ScanEntities` プロシージャは、ブロック参照を発見するたびに、そのブロックの定義（`ThisDrawing.Blocks.Item(…)`）を自ら呼び出して内部を潜っていく。これにより、幾層に重ねられたネストの底にあるブロックまで残らずリスト化する。
③ BOM付きUTF-8によるCSV出力
AutoCADのブロック名には日本語（全角文字）が含まれることが多い。標準の `FileSystemObject` でANSI出力するとExcelで開いた際に文字化けが起きる。コード内の `Chr(&HEF) & Chr(&HBB) & Chr(&HBF)` は、ファイル先頭にUTF-8のBOM（Byte Order Mark）を付与するテクニックであり、実務ツールとしてのユーザビリティを飛躍的に高める。
—
5. 発展：データベースや外部システム連携への布石
このコードで得られたCSVデータ（ハンドル、座標、尺度など）を、そのまま社内の生産管理システムや、PostgreSQLなどのRDB、あるいはPower BIなどのBIツールに流し込むことで、以下のような高度なDX施策が即座に実現できる。
- 図面内の特定部品（型番）の総数を一瞬で集計し、発破リストと突合する。
- 過去の図面資産から、特定のブロックがどこに、どの尺度で配置されているかの位置情報をマッピングする。
AutoCAD VBAは、単に「図面を自動で描くためだけのおもちゃ」ではない。CAD図面を「構造化された構造データ」に変換する最強の武器なのだ。
この知見をあなたの開発環境にインストールし、手作業による図面管理の地獄からチームを解放してほしい。
