AutoCAD VBAを掌握する極限の知見：図面内オブジェクトへの堅牢な連番自動付与システム
AutoCAD VBAを用いた業務自動化において、最も需要が高く、かつ「素人とプロの差が如実に出る」テーマの一つが図面オブジェクトへの連番（シーケンス番号）の自動付与だ。
設備図面の機器番号（EQ-001, EQ-002…）、建築の建具番号、配管のタグ付けなど、手作業で行えばヒューマンエラーの温床となり、膨大な時間を奪われる。しかし、ここに対応するVBAコードを適当に書くだけでは、実務の巨大な図面データの前には秒で破綻する。
今回は、開発プロジェクトのリーダーである私から、「なぜその書き方は非効率で危険なのか」「どう設計すればバグがなく、メンテナンス性が最高峰のシステムになるのか」を、実戦でそのまま使えるプロダクションコードと共に伝授しよう。
—
1. アマチュアの設計とプロの設計：何が命取りになるのか？
世にあるサンプルコードの多くは、単に `For Each` で図面内のオブジェクトを総なめし、見つかった順に文字（Text/MText）を書き換えている。これがいかに危険か、現場のエンジニアなら分かるはずだ。
- 処理順序の崩壊: AutoCADのデータベース内におけるオブジェクトの作成順（H对象的・インデックス順）は、人間が視覚的に認識する「左から右へ、上から下へ」という並びとは全く一致しない。
- マルチドキュメント（MDI）の考慮漏れ: 複数の図面を開いている状態で `ActiveDocument` を安易に叩くと、ユーザーが意図しない別図面を書き換える大惨事につながる。
- トランザクションとパフォーマンスの軽視: 大規模図面で個別のプリミティブ操作を繰り返すと、画面の再描画（Regen）が走り、完了まで数分待たされるか「メモリ不足」で落ちる。
これらを完全にクリアし、実務で耐えうる堅牢なシステムを構築するための設計思想を以下に解説する。
—
2. 堅牢な連番付与システムにおける3つの核心
① 空間座標（X/Y座標）によるソートの義務化
視覚的な順序（例：左上から右下へ）で連番を振るためには、取得したオブジェクトのバウンディングボックス（BoundingBox）や挿入点（InsertionPoint）の座標を抽出し、Y座標降順・X座標昇順で配列を並べ替える（バブルソートやクイックソート等）前処理が不可欠である。
② 選択セット（SelectionSet）のライフサイクル管理
メモリリークの最大の原因は、作成した選択セットを解放（`Delete`）せずに放置することだ。AutoCAD VBAでは、一度作った選択セット名がメモリに残ると次回からエラーを吐く。必ず「存在チェックと安全な削除」をルーティン化する。
③ アトミックな処理とエラーハンドリング
途中でエラーが発生しても、図面が中途半端な状態で保存されないよう、エラーハンドラを厳格に記述する。
—
3. 【プロダクションコード】実務仕様・自動連番付与マクロ
以下のコードは、指定したレイヤまたはブロック名を持つオブジェクトを座標順にソートし、指定プレフィックス＋ゼロパディング（例: `EQ-001`）で属性（Attribute）またはテキストを書き換えるプロフェッショナル仕様のモジュールである。
Option Explicit
‘ ==============================================================================
‘ 処理名: 図面内オブジェクト空間座標順・連番自動付与システム
‘ 概要: 指定した条件のブロックまたはテキストに対し、視覚的順序で連番を付与する
‘ ==============================================================================
Sub AutoAssignSequenceNumber()
‘ 1. 宣言と初期化
Dim acadDoc As AcadDocument
Set acadDoc = ThisDrawing ‘ MDI環境を考慮し、明示的にアクティブ図面をキャプチャ
‘ パフォーマンス向上のための設定
acadDoc.Utility.Prompt vbCrLf & “=== 連番自動付与処理を開始します ===”
Dim sset As AcadSelectionSet
Set sset = CreateSafeSelectionSet(acadDoc, “SeqProcessSet”)
if sset Is Nothing Then Exit Sub
On Error GoTo ErrorHandler
‘ 2. フィルタの設定（例として「ブロック参照」を対象とする）
Dim filterType(0) As Integer
Dim filterData(0) As Variant
filterType(0) = 0
filterData(0) = “INSERT”
sset.Select acSelectionSetAll, , , filterType, filterData
if sset.Count = 0 Then
MsgBox “対象となるオブジェクトが見つかりませんでした。”, vbExclamation, “処理中断”
GoTo Cleanup
End If
‘ 3. 座標ソート用の構造体配列を作成
‘ 実務ではオブジェクトと座標をペアで扱う必要がある
Dim targetObjects() As AcadEntity
ReDim targetObjects(0 To sset.Count – 1)
Dim i As Long
For i = 0 To sset.Count – 1
Set targetObjects(i) = sset.Item(i)
Next i
‘ 座標ソート実行（左上から右下へ：Y降順、X昇順）
Call SortEntitiesByCoordinates(targetObjects)
‘ 4. 連番の付与実行
Dim prefix As String
prefix = “EQ-” ‘ プレフィックスの定義
Dim digitPad As Integer
digitPad = 3 ‘ ゼロパディング桁数（例: 3なら 001）
Dim seqNo As Long
seqNo = 1
‘ 画面描画を停止して爆速化
acadDoc.Application.ScreenUpdating = False
For i = 0 To UBound(targetObjects)
‘ ここではブロック属性（Attribute）を書き換える例を実装
Call UpdateObjectText(targetObjects(i), prefix & Format(seqNo, String(digitPad, “0”)))
seqNo = seqNo + 1
Next i
acadDoc.Application.ScreenUpdating = True
MsgBox “正常に完了しました。総処理数: ” & UBound(targetObjects) + 1, vbInformation, “完了”
Cleanup:
‘ 5. リソースの確実な解放（メモリリーク防止）
Call ReleaseSelectionSet(acadDoc, “SeqProcessSet”)
Exit Sub
ErrorHandler:
acadDoc.Application.ScreenUpdating = True
MsgBox “予期せぬエラーが発生しました。” & vbCrLf & _
“Error Number: ” & Err.Number & vbCrLf & _
“Description: ” & Err.Description, vbCritical, “致命的エラー”
Resume Cleanup
End Sub
‘ — 補助関数: 安全な選択セットの生成 —
Private Function CreateSafeSelectionSet(doc As AcadDocument, setName As String) As AcadSelectionSet
Dim sset As AcadSelectionSet
On Error Resume Next
‘ 既存の同名セットがあれば削除
doc.SelectionSets.Item(setName).Delete
On Error GoTo 0
Set sset = doc.SelectionSets.Add(setName)
Set CreateSafeSelectionSet = sset
End Function
‘ — 補助関数: 選択セットの安全な破棄 —
Private Sub ReleaseSelectionSet(doc As AcadDocument, setName As String)
On Error Resume Next
doc.SelectionSets.Item(setName).Delete
On Error GoTo 0
End Sub
‘ — 補助関数: 座標によるバブルソート（Y座標優先降順、X座標昇順） —
Private Sub SortEntitiesByCoordinates(ByRef arr() As AcadEntity)
Dim i As Long, j As Long
Dim temp As AcadEntity
Dim ptI As Variant, ptJ As Variant
For i = LBound(arr) To UBound(arr) – 1
For j = i + 1 To UBound(arr)
ptI = arr(i).InsertionPoint
ptJ = arr(j).InsertionPoint
‘ Y座標がほぼ同じ場合はX座標で比較（許容誤差を考慮する場合は要調整だが今回はシンプルに比較）
‘ 図面の配置許容値（Yが上のものを優先、Yが同じならXが左のものを優先）
Dim needsSwap As Boolean
needsSwap = False
If Round(ptI(1), 1) < Round(ptJ(1), 1) Then
' Jの方がY座標が高い（上にある）場合、入れ替え
needsSwap = True
ElseIf Abs(Round(ptI(1), 1) - Round(ptJ(1), 1)) <= 1.0 Then
' Y座標がほぼ同じ（同一行とみなす）場合、X座標を比較
If Round(ptI(0), 1) > Round(ptJ(0), 1) Then
‘ Iの方がX座標が大きい（右にある）場合、入れ替え
needsSwap = True
End If
End If
If needsSwap Then
Set temp = arr(i)
Set targetObjects_i = arr(j) ‘ Typo防止のための退避
Set arr(i) = arr(j)
Set arr(j) = temp
End If
Next j
Next i
End Sub
‘ — 補助関数: オブジェクトのテキスト/属性書き換え —
Private Sub UpdateObjectText(ent As AcadEntity, newText As String)
‘ オブジェクトがブロック参照で属性を持つ場合の処理
If TypeOf ent is AcadBlockReference Then
Dim blkRef As AcadBlockReference
Set blkRef = ent
if blkRef.HasAttributes Then
Dim atts As Variant
atts = blkRef.GetAttributes
Dim k As Long
For k = LBound(atts) To UBound(atts)
‘ ここでは特定のタグ名（例: “TAG”）を持つ属性を書き換える
If UCase(atts(k.TagString)) = “TAG” Then
atts(k).TextString = newText
Exit For
End If
Next k
End If
ElseIf TypeOf ent is AcadText Or TypeOf ent is AcadMText Then
‘ 通常の文字・マルチテキストの場合
ent.TextString = newText
End If
End Sub
—
4. 外部データベース（Excel/CSV）連携におけるプロの知見
実務では、「ただ単に連番を振る」だけでなく、「外部のExcel部材リストの並び順通りに図面の番号を同期させたい」という要求が必ず発生する。
この要件を満たす場合、VBA内でExcelコンポーネント（`CreateObject(“Excel.Application”)`）を起動するアプローチは避けるべきだ。Excelの起動・終了オーバヘッドは大きく、環境依存のエラー（Excelのバージョン違いやロック問題）を引き起こしやすい。
ベストプラクティス：CSVインポート方式
1. Excel側からマクロまたはPowerQueryで、設計通りの並び順になったデータを CSV形式で出力 する。
2. AutoCAD VBA側は、標準の `Open … Input` ステートメントでCSVをメモリ上の配列（Dictionaryオブジェクト等）に取り込む。
3. 図面上の機器ID（シリアル番号やGUIDなどのキー情報）とCSVデータを突合し、一括でアトミックに更新する。
このアーキテクチャを採用することで、AutoCADとExcelの結合度が下がり、デバッグが圧倒的に容易になる。
—
5. まとめ
AutoCAD VBAによる自動化の成否は、「オブジェクトモデルのライフサイクルを完全に掌握しているか」にかかっている。
- 無秩序な処理を避け、座標ソートによる論理的順序を担保すること。
- 選択セットの解放と画面更新の制御（`ScreenUpdating = False`）により、パフォーマンスと安定性を極限まで高めること。
- 外部データとの連携は密結合を避け、CSV等のテキストを介した疎結合設計とすること。
この知見をベースに構築されたツールは、日々の設計業務から無駄な疲弊を消し去り、あなたのチームを真のクリエイティブなエンジニアリング集団へとシフトさせるだろう。現場での健闘を祈る。
