こんにちは！AutoCADの自動化の世界へようこそ。
マクロの記録ボタンを押して「なんだか動いたけれど、中身がよくわからない…」という段階から一歩抜け出し、自分の手でCADを自在に操るエンジニアになりたいあなたへ。
今回は、実務で毎日のように直面する「特定の条件に合うオブジェクトをごっそり見つけて、別の画層（レイヤ）に移動させる」というタスクを、AutoCAD VBAでスマートに解決する方法を解説します。
ここをクリアすれば、AutoCAD VBAのオブジェクトモデルの「心臓部」が手に取るようにわかるようになりますよ。しっかりついてきてくださいね！
—
1. なぜ「手作業」ではなく「VBA」なのか？
図面が複雑になってくると、こんな作業が発生しませんか？
- 「赤色で描かれた文字や線を、すべて『INSPECTION』という専用画層に移動させたい」
- 「特定の古い画層にあるオブジェクトを、新しい規格の画層に一網打尽で割り当て直したい」
これを手作業でやろうとすると、クイック選択（QSELECT）を開いて、フィルタを設定して、プロパティパレットから画層を変えて……と、何回も同じ手数を繰り返すことになり、ミスも誘発します。
VBAを使えば、この一連の作業を「0.1秒」で、しかも「絶対にミスなく」実行できます。その裏側にある仕組みを紐解いていきましょう。
—
2. AutoCADオブジェクトモデルの基本概念
AutoCAD VBAを語る上で絶対に外せないのが、「Document（図面）」と「ModelSpace（空間）」、そして「SelectionSet（選択セット）」の関係です。
図面を開くと、そこには `AcadDocument` が存在します。その中にあるすべての図形（線、円、文字など）は、`ModelSpace` または `PaperSpace` というコンテナの中に「コレクション（集まり）」として格納されています。
今回やりたいことのフローは、プログラミングの世界ではこう表現できます。
1. 「今開いている図面のモデル空間」をターゲットにする。
2. その中から、「特定の条件（色や画層など）」に合致するオブジェクトだけをフィルタリングして捕獲する。
3. 捕獲した奴らの `Layer` プロパティを一斉に「新しい画層の名前」に書き換える。
これだけです。非常にシンプルですよね。
—
3. 実装コード：条件抽出と画層一括変更マクロ
それでは、実務でそのままコピペして使える完全版のコードをお見せします。
今回は例として、「図面内の赤い（Color = 転じてACAD_COLORの赤：1）オブジェクトを、すべて『01_RED_DATA』という画層に移動させる」マクロを作ってみましょう。画層がなければ自動で新規作成する親切設計にしています。
Sub MoveObjectsByCondition()
Dim acadDoc As AcadDocument
Set acadDoc = ThisDrawing.ActiveDocument
Dim targetLayerName As String
targetLayerName = “01_RED_DATA”
‘ 1. 移動先の画層がなければ自動作成する
Dim targetLayer As AcadLayer
On Error Resume Next
Set targetLayer = acadDoc.Layers.Add(targetLayerName)
On Error GoTo 0 ‘ エラートラップを解除
‘ 2. フィルタリング用の配列を準備（DXFグループコードを使用）
Dim groupCode(0) As Integer
Dim dataValue(0) As Variant
‘ グループコード 62 は「色番号」を指します
groupCode(0) = 62
dataValue(0) = 1 ‘ 1 = 赤色
Dim filterType As Variant
Dim filterData As Variant
filterType = groupCode
filterData = dataValue
‘ 3. 一時的な「選択セット」を作成する
Dim ssetObj As AcadSelectionSet
‘ すでに同名の選択セットがあれば削除しておく（安全対策）
On Error Resume Next
acadDoc.SelectionSets.Item(“TempFilterSet”).Delete
On Error GoTo 0
Set ssetObj = acadDoc.SelectionSets.Add(“TempFilterSet”)
‘ 4. 条件に合うオブジェクトを一網打尽で選択セットに追加
ssetObj.Select acSelectionSetAll, , , filterType, filterData
‘ 5. ヒットしたオブジェクトの画層を書き換える
Dim entryObj As AcadEntity
Dim counter As Long
counter = 0
If ssetObj.Count > 0 Then
For Each entryObj In ssetObj
‘ 画層プロパティを書き換えるだけで移動完了！
entryObj.Layer = targetLayerName
counter = counter + 1
Next entryObj
MsgBox counter & ” 個のオブジェクトを画層「” & targetLayerName & “」に移動しました。”, vbInformation, “処理完了”
Else
MsgBox “条件に合致するオブジェクトは見つかりませんでした。”, vbExclamation, “通知”
End
‘ 6. 使い終わった選択セットは必ずメモリから解放する（重要！）
ssetObj.Delete
End Sub
—
4. コードの深掘りポイント（チーフアーキテクトの知見）
このコードには、実務でコードを書く上で絶対に知っておかなければならない「エンジニアの知見」が詰まっています。いくつか重要なポイントを解説します。
① DXFグループコードによる超高速フィルタリング
`ssetObj.Select acSelectionSetAll, , , filterType, filterData` という一行。
ここで使っているのがAutoCADの心臓部であるDXFグループコードです。
- `62` は「色」を表すコード。
- `8` にすれば「画層名」でフィルタリングできます。
- `0` にすれば「図形の種類（LINE, CIRCLEなど）」でフィルタリングできます。
ループを回して一つずつ `If` 文で判定していくような愚かな（そして遅い）コードを書く必要はありません。AutoCADのエンジン側に一発でフィルタリングさせることで、数万個のオブジェクトがある重い図面でも一瞬で処理が終わります。
② メモリ管理の鉄則：SelectionSetsの削除
AutoCAD VBAで最も多いバグが、「選択セットの残骸によるエラー」です。
一度作成した `AcadSelectionSet` は、明示的に `.Delete` しない限り、図面ファイルの中に残り続けます。次に同じ名前のマクロを走らせたときに「すでに存在します」という致命的なエラー（実行時エラー ‘457’）が発生します。
コード内で作ったら、使い終わったら必ず消す。これがプロの作法です。
—
5. まとめと次のステップ
今回は「条件に合致するオブジェクトを抽出し、一括で別画層へ移動させる」という実務直結のテクニックを解説しました。
ここをクリアしたあなたなら、グループコードの数字を変えるだけで、
- 「特定の線種（LINETYPE）のオブジェクトだけを集める」
- 「特定の画層にある文字（TEXT）だけを別の画層に送る」
といった応用が自由自在にできるようになります。
「マクロの記録」の枠を飛び出し、自分の意のままにAutoCADをコントロールする快感……少しずつ味わえてきたのではないでしょうか？
この調子で、日々の退屈な定型作業をコードの力で次々と自動化していきましょう。次のステップも、最高に知的なエンジニアリングの世界へご案内します。お疲れ様でした！
