AutoCAD VBAを掌握する極限の知見：`GetCorner`で窓選択UIを完全制御する堅牢な矩形抽出ロジック
AutoCAD VBAによる業務自動化において、真にプロフェッショナルなツールと、素人が作った「おもちゃのスクリプト」を分かつ境界線はどこにあるか。それは「ユーザーインタラクションの堅牢性と、AutoCADデータベースのライフサイクルを正しく理解しているか」の一点に尽きる。
図面内から特定の領域を指定させ、その内部にあるエンティティを操作する処理は、集計・検図・一括修正などの実務ツールで頻出する要件だ。ここで安易に `ThisDrawing.Utility.GetPoint` を2回呼んで座標を繋ぎ合わせるようなコードを書いているようでは、実務の現場では使い物にならない。ESCキーによる中断処理、UCS（ユーザー座標系）とWCS（世界座標系）の変換、そしてメモリリークを防ぐためのオブジェクト解放の作法。これらを完璧に網羅した実装こそが求められる。
今回は、`AcadDocument.Utility.GetCorner` メソッドを極限まで使い倒し、プロの現場に耐えうる「窓選択を模した範囲指定ツール」の設計思想と実装コードを全公開する。
—
1. なぜ `GetCorner` なのか？ ―― 開発プロジェクトリーダーからの警鐘
多くの初学者は、2点の座標を取得する際に以下のようなコードを書く。
‘ 【アンチパターン】絶対にやってはいけない実装
Dim pt1 As Variant
Dim pt2 As Variant
pt1 = ThisDrawing.Utility.GetPoint(, “1点目を指定:”)
pt2 = ThisDrawing.Utility.GetPoint(, “2点目を指定:”)
このアプローチには致命的な欠陥が3つある。
1. 視覚的フィードバックの欠如：1点目を指定したあと、2点目にカーソルを移動する際に、矩形のプレビュー（ゴムバンド効果）が表示されないため、ユーザーはどのような範囲を指定しているか直感的に把握できない。
2. UXの乖離：AutoCAD標準の選択操作（窓選択/交差選択）と挙動が異なり、ユーザーにストレスを与える。
3. エラーハンドリングの欠落：ユーザーが途中で `ESC` キーを押した際のトラップが考慮されておらず、実行時エラーでマクロが強制終了する。
これらを一撃で解決するのが、`Utility.GetCorner` メソッドだ。
Dim ptFirst As Variant
Dim ptCorner As Variant
‘ 1点目を取得
ptFirst = ThisDrawing.Utility.GetPoint(, “矩形の1点目を指定してください: “)
‘ 1点目を基点として、リアルタイムの矩形プレビューを伴う2点目を取得
ptCorner = ThisDrawing.Utility.GetCorner(ptFirst, “対角点を指定してください: “)
`GetCorner` は、第一引数に渡した基準点からマウスカーソルまでの矩形枠を動的に描画しながら、2点目の入力を待つというAutoCADネイティブの優れたUI挙動をVBAから完全にハックできる。
—
2. 堅牢な範囲指定ツールの設計要件
プロダクションコードとして組み込むにあたり、以下の要件をクリアする設計とする。
1. UCS/WCSの厳密なハンドリング：
取得した座標は常に「現在のUCS基準」で返される。これをデータベース照合用の「WCS（世界座標系）」へ確実に変換する、あるいは図面上の判定ロジックで破綻しない工夫が必要となる。
2. バウンディングボックス（境界箱）の正規化：
ユーザーが右から左へ、あるいは上から下へドラッグした場合、X/Y座標の大小関係（Min/Max）が逆転する。これをプログラム側で自動的に正規化（並び替え）しなければ、包含判定でバグる。
3. エラー・例外の完全制御：
`ESC` キー押下による `Err.Number = -2147352567 (automation error)` などを的確に捕捉し、サイレントかつクリーンに終了させる。
—
3. 【プロダクションコード】矩形範囲抽出ツールの完全実装
以下のコードをAutoCADの標準モジュールに貼り付けるだけで、即座に実務レベルの処理を実行できる。
Option Explicit
”’
”’
Public Sub ExtractEntitiesByRectangle()
‘ エラーハンドリングの有効化
On Error GoTo ErrorHandler
Dim acadApp As AcadApplication
Set acadApp = ThisDrawing.Application
‘ 画面更新を一時停止してパフォーマンスを最大化
acadApp.ScreenUpdate = False
Dim util As AcadUtility
Set util = ThisDrawing.Utility
‘ 1. 1点目の取得（エラー対策としてVariant型で受ける）
Dim ptFirst As Variant
ptFirst = util.GetPoint(, vbCrLf & “【範囲指定】1点目を指定してください: “)
‘ 2. 対角点の取得（GetCornerによるプレビュー表示）
Dim ptCorner As Variant
ptCorner = util.GetCorner(ptFirst, vbCrLf & “【範囲指定】対角点を指定してください: “)
‘ 3. 座標の正規化（Min/Maxの確定）
Dim minPt(2) As Double
Dim maxPt(2) As Double
Call NormalizeCoordinates(ptFirst, ptCorner, minPt, maxPt)
‘ 4. 範囲内のオブジェクト走査と抽出
Dim selectedCount As Long
selectedCount = ProcessEntitiesInBoundingBox(minPt, maxPt)
‘ 処理終了の通知
acadApp.ScreenUpdate = True
MsgBox “処理が完了しました。” & vbCrLf & “抽出されたオブジェクト数: ” & selectedCount, vbInformation, “範囲抽出ツール”
Exit Sub
ErrorHandler:
‘ ユーザーがESCキーで中断した場合（Err.Number 468 または -2147352567等）
acadApp.ScreenUpdate = True
If Err.Number <> 0 And Err.Number <> 468 Then
‘ 意図しないエラーのみ通知
If Err.Number <> -2147352567 Then
MsgBox “予期せぬエラーが発生しました: ” & Err.Description, vbCritical, “エラー”
End If
End If
End Sub
”’
”’
Private Sub NormalizeCoordinates(ByRef p1 As Variant, ByRef p2 As Variant, ByRef minOut() As Double, ByRef maxOut() As Double)
Dim i As Long
For i = 0 To 2
If p1(i) < p2(i) Then
minOut(i) = p1(i)
maxOut(i) = p2(i)
Else
minOut(i) = p2(i)
maxOut(i) = p1(i)
End If
Next i
' Z軸は範囲選択の高さを持たないため、必要に応じて上下に拡張・固定する
minOut(2) = -1E+20
maxOut(2) = 1E+20
End Sub
'''
”’
Private Function ProcessEntitiesInBoundingBox(ByRef minPt() As Double, ByRef maxPt() As Double) As Long
Dim ent As AcadEntity
Dim count As Long
count = 0
Dim mSpace As AcadModelSpace
Set mSpace = ThisDrawing.ModelSpace
Dim boundingMin As Variant
Dim boundingMax As Variant
‘ すべてのオブジェクトをループ
For Each ent In mSpace
‘ 各エンティティのバウンディングボックス（境界ボックス）を取得
On Error Resume Next
ent.GetBoundingBox boundingMin, boundingMax
If Err.Number = 0 Then
‘ 2D空間（X, Y）での包含判定（簡易的なAABB衝突判定）
If IsBoxIntersected(minPt, maxPt, boundingMin, boundingMax) Then
‘ — 【ここに実務処理を記述】 —
‘ 例：該当エンティティの色を赤（ColorIndex = 1）に変更する
ent.Color = acRed
count = count + 1
‘ ———————————-
End If
End If
On Error GoTo 0
Next ent
ProcessEntitiesInBoundingBox = count
End Function
”’
”’
Private Function IsBoxIntersected(ByRef r1Min() As Double, ByRef r1Max() As Double, ByRef r2Min() As Double, ByRef r2Max() As Double) As Boolean
‘ X軸およびY軸の重なりを判定
If r1Max(0) < r2Min(0) Or r1Min(0) > r2Max(0) Then Exit Function
If r1Max(1) < r2Min(1) Or r1Min(1) > r2Max(1) Then Exit Function
IsBoxIntersected = True
End Function
—
4. チーフアーキテクトが教える「現場で絶対にハマる罠」と回避策
上記のコードを実務の巨大図面（数万〜数十万オブジェクト）に適用する際、エンジニアが直面するパフォーマンスとメモリの壁がある。ここをクリアしてこそ、真のプロフェッショナルだ。
① `For Each ent In mSpace` の罠とメモリ管理
AutoCAD VBAにおいて、`ModelSpace` や `SelectionSet` を `For Each` で回すコードは、COMオブジェクトの参照カウンタを大量に消費する。図面が巨大化すると、メモリリークや「Automation Error」の原因になる。
- 対策：定常的なツールであれば、極力 `SelectionSet`（選択セット）の `Select` メソッド（`acSelectionSetWindow` や `acSelectionSetCrossing`）のネイティブフィルタ機能を使用するべきだ。ただし、複雑なカスタム判定を入れたい場合は、上記のようにバウンディングボックスを自前で高速評価するハイブリッド設計が有効となる。
② スクリーンアップデートの重要性
`acadApp.ScreenUpdate = False` を記述している理由を理解してほしい。AutoCADはオブジェクトのプロパティ（例: `ent.Color = acRed`）が書き換わるたびに、画面の再描画（Viewportの再計算）を行おうとする。数千回の書き込みが走った場合、これだけで数分のロスタイムが発生する。
描画を凍結し、メモリ上で高速に処理を完結させ、最後に一度だけ `ScreenUpdate = True` でリフレッシュする。これがプロの速度を担保する鉄則である。
—
5. 総括
`AcadDocument.Utility.GetCorner` を用いた範囲指定ツールの開発は、単なる座標の取得に留まらない。「UIの視覚的整合性」「座標系の正規化」「パフォーマンスの最適化」「堅牢なエラーハンドリング」という、AutoCAD VBA開発におけるすべての重要スキルが凝縮されたテーマだ。
安易なコードのコピペで現場の図面をクラッシュさせる時代は終わった。この知見をベースに、あなたの開発するツールを圧倒的に堅牢で、実用的なものへと昇華させてほしい。
