AutoCAD VBAを掌握する極限の知見：`GetCorner`がもたらすUI革命と、実務に耐えうるBOM集計の極意
こんにちは、チーフアーキテクトの私だ。
日々のCADオペレーションにおいて、「画面上の特定のエリアをマウスでサクッと囲んで、その中にある部品を集計したい」という要求は、もはや日常茶飯事だろう。
だが、君たちの書いているVBAコードを見てみると、未だに`PromptForPoint`を2回使って対角を無理やり取得させたり、座標の大小比較ロジックを毎回泥臭く実装していたりしないか？
古臭いUIの押し付けは、現場のエンジニアのストレスをマッハで加速させる。
今回は、AutoCAD VBAの隠れた名優 `AcadDocument.Utility.GetCorner` を完全掌握し、ユーザーにストレスフリーな「ラバーバンド付き矩形範囲指定」を提供する。さらに、大規模図面でも重くならない、実務直結の高速BOM集計アルゴリズムを授けよう。
—
1. なぜ `GetCorner` なのか？（UI/UXの最適化）
通常のVBA開発者は、ユーザー入力を受け付ける際、`GetPoint` を使いがちだ。しかし、矩形（四角形）領域を指定させたい場合、2点を別々にクリックさせるのはUIとして三流である。
`GetCorner` メソッドのシグネチャを見てみよう。
RetPoint = Utility.GetCorner(Point, Prompt)
- `Point`: 1点目（基準点）の3次元座標（Variant配列）
- `Prompt`: コマンドラインに表示する文字列
このメソッドの真骨頂は、1点目を指定した瞬間から、マウスカーソルの動きに合わせて動的な矩形（ラバーバンド）が画面上に描画される点にある。ユーザーは「今、どこからどこまでを指定しようとしているのか」を視覚的に完全に把握しながら2点目を決定できる。このフィードバックの有無が、ツール全体の品質を決定づけるのだ。
—
2. 実務における設計の罠と解決策
`GetCorner` を使う上で、プロが必ず押さえておかなければならない「2つのトラップ」がある。
トラップ①：ビューポートの回転・UCS（ユーザー座標系）問題
ユーザーがWCS（世界座標系）以外のUCSで作業している場合、`GetCorner` が返す座標系と、モデル空間上の図形の座標系がズレる危険性がある。
対策: 座標取得時は常に `ThisDrawing.ActiveUCS` の影響を考慮するか、取得した座標を確実にWCSへ変換、あるいはバウンディングボックス判定において適切に正規化するロジックを組む必要がある。
トラップ②：矩形範囲の「包含判定」の罠
2点で囲まれた矩形から、最小X/Y/Zと最大X/Y/Zを算出し、図形のバウンディングボックス（`GetBoundingBox`）と比較する際、「完全包含」なのか「一部交差」なのかの仕様を明確にしなければならない。
実務のBOM集計では、「枠に少しでも触れているものは含めるのか、完全に内包されているものだけか」で結果が大きく変わる。今回は堅牢性を考慮し、「指定した矩形のバウンディングボックスと、図形のバウンディングボックスが交差（あるいは包含）しているか」を判定するアルゴリズムを採用する。
—
3. 【プロダクションコード】ラバーバンド矩形によるリアルタイムBOM集計
それでは、実務の現場でそのまま稼働するプロダクションコードを公開する。
このコードは、エラーハンドリング、座標の正規化、そして高速なエンティティ走査を網羅した完全版だ。
Option Explicit
‘ =================================================================================
‘ 処理名: 矩形範囲指定型 リアルタイムBOM集計エンジン
‘ 概要 : GetCornerによるラバーバンド矩形を描画し、その領域内のブロック属性を抽出・集計する
‘ =================================================================================
Public Sub AggregateBOMByRectangle()
‘ エラーハンドリングの標準設定
On Error GoTo ErrorHandler
Dim util As AcadUtility
Set util = ThisDrawing.Utility
‘ 1. 基点（1点目）の取得
Dim basePoint As Variant
basePoint = util.GetPoint(, vbCrLf & “【BOM集計】矩形の1点目を指定してください: “)
‘ 2. ラバーバンド付き対角点（2点目）の取得
Dim cornerPoint As Variant
cornerPoint = util.GetCorner(basePoint, vbCrLf & “【BOM集計】対角点を指定して範囲を決定: “)
‘ 3. 矩形座標の正規化（どちらの方向にドラッグしてもMin/Maxを正しく算出するため）
Dim minX As Double, minY As Double, maxX As Double, maxY As Double
minX = IIf(basePoint(0) < cornerPoint(0), basePoint(0), cornerPoint(0))
minY = IIf(basePoint(1) < cornerPoint(1), basePoint(1), cornerPoint(1))
maxX = IIf(basePoint(0) > cornerPoint(0), basePoint(0), cornerPoint(0))
maxY = IIf(basePoint(1) > cornerPoint(1), basePoint(1), cornerPoint(1))
‘ 4. コレクション（またはDictionary）を用いた高速集計の準備
‘ ※ 事前に「Microsoft Scripting Runtime」の参照設定を推奨するが、
‘ バインド遅延(CreateObject)で環境依存を排除する
Dim bomDict As Object
Set bomDict = CreateObject(“Scripting.Dictionary”)
Dim ent As AcadEntity
Dim blockRef As AcadBlockReference
Dim matchedCount As Long
matchedCount = 0
‘ 5. モデル空間の全図形スキャン（パフォーマンス最適化のため必要最小限のプロパティのみアクセス）
Dim ws As AcadModelSpace
Set ws = ThisDrawing.ModelSpace
For Each ent In ws
‘ ブロック参照（挿入図形）のみをターゲットにする
If TypeOf ent Is AcadBlockReference Then
Set blockRef = ent
‘ 図形のバウンディングボックスを取得
Dim ptMin As Variant, ptMax As Variant
On Error Resume Next ‘ 非バウンド図形などの例外回避
blockRef.GetBoundingBox ptMin, ptMax
On Error GoTo ErrorHandler
If Err.Number = 0 Then
‘ 矩形範囲との当たり判定（簡易2D判定: X軸とY軸の重なりチェック）
‘ 指定矩形とブロックのバウンディングボックスが交差しているか
If Not (ptMax(0) < minX o_r ptMin(0) > maxX o_r ptMax(1) < minY o_r ptMin(1) > maxY) Then
‘ 部品名（ブロック名）の取得。動的ブロックの場合はEffectiveNameを使用
Dim partName As String
partName = GetEffectiveBlockName(blockRef)
‘ 辞書にカウントアップ
If bomDict.Exists(partName) Then
bomDict(partName) = bomDict(partName) + 1
Else
bomDict.Add partName, 1
End If
matchedCount = matchedCount + 1
End If
End If
End If
Next ent
‘ 6. 集計結果の出力（イミディエイトウィンドウ ＋ Excel連携の踏み台）
Call OutputBOMResult(bomDict, matchedCount)
Exit Sub
ErrorHandler:
If Err.Number <> -2147352567 Then ‘ ユーザーによるESCキャンセル(-2147352567等)は無視
MsgBox “予期せぬエラーが発生しました: ” & Err.Description, vbCritical, “BOM集計ツール”
End If
End Sub
‘ =================================================================================
‘ ヘルパー関数: ブロック名（ダイナミックブロック対応）の取得
‘ =================================================================================
Private Function GetEffectiveBlockName(ByVal blockRef As AcadBlockReference) As String
Dim bName As String
bName = blockRef.Name
‘ ダイナミックブロックの場合、実際のマスター名を取得する
If blockRef.IsDynamicBlock Then
Dim dynProps As Variant
‘ AutoCADの内部仕様に対応するためQuietlyに処理
On Error Resume Next
bName = blockRef.EffectiveName
On Error GoTo 0
End If
GetEffectiveBlockName = bName
End Function
‘ =================================================================================
‘ ヘルパー関数: 集計結果のレポート出力
‘ =================================================================================
Private Sub OutputBOMResult(ByVal bomDict As Object, ByVal totalCount As Long)
Debug.Print “==========================================”
Debug.Print ” 【 矩形範囲BOM集計レポート 】 ”
Debug.Print “==========================================”
Debug.Print ” 抽出総数: ” & totalCount & ” 点”
Debug.Print “——————————————”
If bomDict.Count = 0 Then
Debug.Print ” 対象範囲内に該当する部品はありませんでした。”
MsgBox “指定された範囲内に集計対象の部品は見つかりませんでした。”, vbInformation, “BOM集計”
Exit Sub
End If
Dim keys As Variant
keys = bomDict.Keys
Dim i As Long
For i = 0 To bomDict.Count – 1
Debug.Print ” 部品名: ” & keys(i) & ” ｜ 数量: ” & bomDict(keys(i))
Next i
Debug.Print “==========================================”
MsgBox “BOM集計が完了しました。” & vbCrLf & _
“種類数: ” & bomDict.Count & ” / 総数: ” & totalCount & vbCrLf & _
“詳細はイミディエイトウィンドウを確認してください。”, vbInformation, “集計完了”
End Sub
—
4. コードのアーキテクチャ的解説（プロフェッショナルの視点）
このコードが「実務中級以上」を名乗る理由を、3点に絞って解説する。
1. 座標の正規化ロジックの徹底
ユーザーがマウスを「右から左」「下から上」へドラッグした場合、`basePoint` と `cornerPoint` の大小関係が逆転する。これを `IIf` 関数を用いた正規化処理によって `minX/maxX` を担保しているため、どんな方向のドラッグでも破綻しない。
2. ダイナミックブロック（Dynamic Block）への完全対応
実務の図面で普通のブロックが使われることは少ない。大抵はダイナミックブロックだ。通常の `.Name` を取得すると無機質な匿名ブロック名（`U#`形式）が返ってきて集計が崩壊する。ヘルパー関数 `GetEffectiveBlockName` 内で `.IsDynamicBlock` と `.EffectiveName` をハンドリングしている点が、現場で生き残るための必須実装だ。
3. DictionaryオブジェクトによるO(1)高速集計
配列の再定義（`ReDim Preserve`）をループ内で行う素人コードは、図面要素が数千個を超えた瞬間にフリーズする。`Scripting.Dictionary` を用いることで、部品名の検索と加算をメモリ上で一瞬（$O(1)$の計算量）で処理している。
—
5. さらなる高みへ（データベース連携への布石）
このコードは現在、結果を `Debug.Print` と `MsgBox` で出力しているが、実務ではここからさらに発展させるべきだ。
- Excelシームレス連携: 取得した `Dictionary` の中身を、裏で起動したExcel (`CreateObject(“Excel.Application”)`) にワンクリックで転記し、フォーマット済みのパーツリストを自動生成する。
- ERP/PLM連携: 取得した部品名（パーツ番号）を社内の基幹データベース（SQL Server等）にADO経由で投げて、最新の単価や在庫ステータスをリアルタイムにCAD上にポップアップ表示させる。
`GetCorner` による洗練されたUIの提供は、そのすべての起点となる。
泥臭いマクロの時代は終わった。
オブジェクトモデルの本質を理解し、ユーザーが心地よいと感じるレスポンスと、裏で確実に仕事をこなす堅牢な設計を両立させること。それこそが、我々エンジニアの仕事なのだ。
実装で分からない点があれば、いつでもこのアーキテクチャに立ち返ってほしい。健闘を祈る。
