【上級】AutoCAD VBAで図面上のオブジェクトを自動削除!条件指定による高度な削除
AutoCAD VBAによる自動化において、「図面から不要なオブジェクトを削除する」という処理は、一見すると極めて単純なタスクに見える。ネット上を検索すれば、`Delete`メソッドを呼び出すだけのコードは山ほど転がっている。
しかし、実務の現場――それも数万〜数十万のエンティティが蠢く巨大なプラント図面や建築図面において、その「適当なコード」は、深刻なメモリリーク、想定外の図面破壊、そして耐え難いほどの処理遅延(フリーズ)を引き起こす爆弾と化す。
私はこれまでに数多のレガシーなマクロをリファクタリングしてきた。その経験から断言する。
「ただ消すだけ」のコードを書く時代は終わった。プロフェッショナルが満たすべき条件は、「イテレーションの安全性」「高速性(トランザクション的思考)」「厳密な条件判定」の3点だ。
今回は、AutoCAD VBAのオブジェクトモデルの深淵を知る者だけが書ける、実務投入レベルの堅牢な「条件指定オブジェクト削除エンジン」を伝授する。
—
1. なぜ「単純なループ削除」は実務で破綻するのか?
多くの初学者が陥る罠が、以下のようなコードだ。
‘ 【アンチパターン】絶対にやってはいけない削除ループ
Dim i As Long
For i = 0 to acadDoc.ModelSpace.Count – 1
Set ent = acadDoc.ModelSpace.Item(i)
If ent.Layer = “OLD_LAYER” Then
ent.Delete ‘ ← コレクションの要素数が減るためインデックスが狂う!
End If
Next i
コレクションを前方から順に走査しながら `Delete` メソッドを実行すると、インデックスの整合性が崩壊し、削除漏れが発生するだけでなく、最悪の場合は実行時エラーでVBAが強制終了する。
さらに、AutoCAD VBAでは、オブジェクトへの参照がメモリ上に残ったまま削除処理を行うと、ドキュメントのデータベース(AcadDatabase)との間で不整合が生じ、`.dwg` 保存時の破損リスクが高まる。
—
2. 堅牢な削除エンジンの設計思想
実務で耐えうるクリーンアップツールを構築するためには、以下のアーキテクチャを採用する。
1. 逆順ループ(Backward Loop)による安全な走査
コレクションの末尾から先頭に向かってループを回すことで、インデックスのズレを完全に回避する。
2. 厳密なエラーハンドリングとオブジェクトの解放
削除対象外のオブジェクトや、すでに解放されたメモリへのアクセスを防ぐためのガードを設ける。
3. 複数条件の柔軟なカプセル化(ファンクション分離)
「どの画層か」「どのタイプか」「どの色か」といった条件判定をメインロジックから切り離し、保守性を高める。
—
3. 【プロダクションコード】実務仕様・高度条件削除マクロ
以下のコードは、指定した「画層名」「オブジェクトタイプ(例: AcadLine, AcadTextなど)」「カラーIndex」の複合条件に合致するモデル空間上のエンティティを一括かつ安全に削除する実用スクリプトである。
Option Explicit
‘ =========================================================================
‘ 模範的プロダクションコード:条件指定型オブジェクト一括削除エンジン
‘ Author: Chief Architect
‘ Description:
‘ 指定された画層、オブジェクト型、色インデックスの複合条件に基づき、
‘ モデル空間上のエンティティを安全かつ高速に削除する。
‘ =========================================================================
Public Sub ExecuteAdvancedCleanUp()
‘ 1. 実行前の確認とパフォーマンス最適化
Dim startTime As Double
startTime = Timer
‘ 画面描画を停止し、処理速度を劇的に向上させる(必須のプロテクニック)
ThisDrawing.Application.ScreenUpdating = False
On Error GoTo ErrorHandler
Dim targetLayer As String
Dim targetObjectType As String
Dim targetColor As Integer
Dim useLayerFilter As Boolean
Dim useTypeFilter As Boolean
Dim useColorFilter As Boolean
‘ — 【設定エリア】ここに削除条件を定義する —
targetLayer = “TEMP_DIMENSIONS” ‘ 対象画層名
useLayerFilter = True ‘ 画層条件を有効にするか
targetObjectType = “AcDbText” ‘ 対象オブジェクトのDXF名 (例: AcDbLine, AcDbText, AcDbCircle)
useTypeFilter = True ‘ タイプ条件を有効にするか
targetColor = 1 ‘ 対象カラーIndex (1 = 赤)
useColorFilter = False ‘ カラー条件を有効にするか
————————————————–
Dim modelSpace As AcadModelSpace
Set modelSpace = ThisDrawing.ModelSpace
Dim totalCount As Long
totalCount = modelSpace.Count
Dim deletedCount As Long
deletedCount = 0
Dim i As Long
Dim ent As AcadEntity
‘ 2. 【重要】コレクション破壊を防ぐための「逆順ループ」
For i = totalCount – 1 To 0 Step -1
Set ent = modelSpace.Item(i)
‘ 削除判定フラグの評価
If EvaluateConditions(ent, targetLayer, useLayerFilter, _
targetObjectType, useTypeFilter, _
targetColor, useColorFilter) Then
‘ オブジェクトの削除
ent.Delete
deletedCount = deletedCount + 1
End If
‘ ループ内でのメモリ解放(参照のクリア)
Set ent = Nothing
Next i
‘ 3. 終了処理
ThisDrawing.Application.ScreenUpdating = True
‘ 処理結果のレポート
MsgBox “クリーンアップが完了しました。” & vbCrLf & _
“総スキャン数: ” & totalCount & vbCrLf & _
“削除オブジェクト数: ” & deletedCount & vbCrLf & _
“処理時間: ” & Format(Timer – startTime, “0.00”) & ” 秒”, _
vbInformation, “AutoCAD VBA CleanUp Engine”
Exit Sub
ErrorHandler:
‘ 異常終了時も必ず画面描画を復旧させる
ThisDrawing.Application.ScreenUpdating = True
MsgBox “致命的なエラーが発生しました: ” & Err.Description, vbCritical, “エラー”
End Sub
‘ =========================================================================
‘ 条件判定プライベート関数(拡張性・保守性の担保)
‘ =========================================================================
Private Function EvaluateConditions(ByRef ent As AcadEntity, _
ByVal targetLayer As String, ByVal useLayer As Boolean, _
ByVal targetType As String, ByVal useType As Boolean, _
ByVal targetColor As Integer, ByVal useColor As Boolean) As Boolean
Dim isMatch As Boolean
isMatch = True ‘ 初期値は真(条件に合致していると仮定)
‘ ヌル参照のガード
If ent Is Nothing Then
EvaluateConditions = False
Exit Function
End If
‘ 1. 画層条件の評価
If useLayer Then
If StrComp(ent.Layer, targetLayer, vbTextCompare) <> 0 Then
isMatch = False
End If
End If
‘ 2. オブジェクトタイプ条件の評価 (EntityName または ObjectName)
If isMatch And useType Then
If StrComp(ent.ObjectName, targetType, vbTextCompare) <> 0 Then
isMatch = False
End If
End If
‘ 3. カラー条件の評価
If isMatch And useColor Then
If ent.Color <> targetColor Then
isMatch = False
End If
End If
EvaluateConditions = isMatch
End Function
—
4. コードの深掘りとアーキテクチャの解説
1. `ScreenUpdating = False` によるパフォーマンスの爆発的向上
AutoCADは、VBAからオブジェクトが1つ削除されるたびに、画面の再描画(グラフィックスパイプラインの更新)を行おうとする。数千個のオブジェクトを消す場合、これだけで数秒〜数十秒のロスが生じる。
処理の冒頭で `ScreenUpdating = False` にし、終了時に `True` に戻すことで、描画処理をバイパスし、メモリ内で一気に計算を完結させることがプロの鉄則だ。
2. `ObjectName` と `EntityName` の使い分け
AutoCAD VBAにおいて、オブジェクトの型を判定する際は `ent.ObjectName` (例: `AcDbLine`, `AcDbText` など)を使用するのが最も確実である。DXFリファレンスに準拠した内部クラス名を文字列で比較するため、型ミスのない厳密なフィルタリングが可能になる。
3. メモリ管理の作法 (`Set ent = Nothing`)
VBAのガベージコレクションは頼りにならない。特にAutoCADのCOMオブジェクトを扱うループ内では、イテレーションごとに変数 `ent` の参照を明示的に `Nothing` に解放し続けることで、VBAランタイムのヒープ領域圧迫を防ぎ、メモリリークを根絶する。
—
5. おわりに:さらなる高みへ(SelectionSetの活用について)
今回はモデル空間全体を逆順ループで舐める方法を解説したが、もし対象オブジェクトが数万を超える極めて巨大な図面である場合、VBAのループ処理自体がボトルネックになる。
その場合の次なる一手として、SelectionSet(選択セット) を用いたAutoCAD内部エンジンによるフィルター処理(`Select`メソッドの引数にDXFグループコードを指定する手法)の採用を検討してほしい。
しかし、複雑な条件分岐や、カスタムプロパティ、あるいは図面横断的なクリーンアップを行う上では、今回紹介した「安全な逆順ループによるロジカルな判定エンジン」が最も泥臭く、そして絶対に裏切らない最強の武器となる。
現場の生産性を極限まで引き上げるエンジニアリングを、あなたの手で実装してほしい。
