AutoCAD VBAを掌握する極限の知見
第1回：ビューポートの罠を撃破せよ —— `TranslateCoordinates` によるペーパー空間からモデル空間への完全座標変換
開発プロジェクトのリーダーである私たちが、現場の自動化ツール作成において最も直面し、そして最も多くのエンジニアが玉砕するポイントはどこか？
それは「座標系の不一致」だ。
特に、レイアウト（ペーパー空間）上でユーザーにクリックさせ、その位置に対応するモデル空間上の正確な実寸座標を割り出し、注釈やブロックを配置する――この一連の処理を実装したとき、多くの初心者はこう絶望する。
「なぜ、取得した座標が全く見当違いの場所へ飛ぶのか？」と。
今回は、AutoCADのオブジェクトモデルの深部を抉り、`AcadDocument.Utility.TranslateCoordinates` を完全統御するための極限の知見を授けよう。
—
1. なぜ「そのままの座標」では通用しないのか？
AutoCADのドキュメント構造は、ペーパー空間（レイアウト）とモデル空間という、全く異なるスケールと原点を持つ2つの次元で構成されている。
レイアウト上に配置されたビューポート（`AcadViewport` または `AcadPViewport`）は、いわば「モデル空間を覗き見る窓」である。
- ペーパー空間の単位は通常「ミリ（mm）」や「インチ」。
- モデル空間の単位は、プラント図面であれば「ミリ」、建築図面であれば「メートル」など、プロジェクトのスケールに依存し、さらにビューポート内でズーム倍率（縮尺）と画面パン（中心点）のオフセットを受けている。
この「2つの世界の翻訳」を怠り、ペーパー空間の `MouseClick` 座標をそのままモデル空間のオブジェクト生成に使えば、図面が広大な宇宙の彼方に吹っ飛ぶか、目に見えないほどのミクロな点として生成される。
ここで登場するのが、AutoCAD APIが誇る最強の変換メソッド、`TranslateCoordinates` である。
—
2. `TranslateCoordinates` の仕様とトラップ
このメソッドは一見万能に見えるが、そのインターフェースは極めて厳格であり、引数の設計を一つ誤るだけで無言のバグ（あるいは致命的な実行時エラー）を引き起こす。
RetVal = AcadUtility.TranslateCoordinates(Point, FromSpace, ToSpace, Disp [, Disp])
実務でペーパー空間からモデル空間へ座標を飛ばす際、私たちが指定すべきパラメータの組み合わせは以下の通り固定される。
1. `Point`: 変換したい3次元座標（配列）。
2. `FromSpace`: `acPaperSpace`（ペーパー空間）
3. `ToSpace`: `acModelSpace`（モデル空間）
4. `Disp`: 座標点（Point）を「位置（Location）」として扱うか「変位（Displacement / ベクトル）」として扱うかのフラグ。位置なら `False` を指定する。
🚨 致命的な罠：ビューポートの「アクティブ化」問題
ここで、現場のプロが必ずハマる最大の罠を共有しよう。
`TranslateCoordinates` を使ってペーパー空間からモデル空間へ座標を変換する際、「対象となるビューポートがアクティブ（Model Spaceがアクティブな状態）でなければならない」 という隠れた制約が存在する。
レイアウトタブを開いただけのデフォルト状態（ペーパー空間がアクティブ）では、ビューポート内の正確なズーム倍率やビューの中心座標をAPIが正しく解決できず、変換結果が狂うかエラーになる。
堅牢なコードを書くためには、プログラム側で対象ビューポートへ一時的に視点を切り込む（`ActivePViewport` の設定）ロジックが不可欠なのだ。
—
3. 【プロダクションコード】実務で耐えうる堅牢な座標変換ロジック
それでは、理論を実戦に移す。
以下のコードは、レイアウト空間でユーザーに点を指示させ、その直下にあるビューポートを自動特定し、ペーパー空間の座標を正確なモデル空間の座標へ変換した上で、そこにテキスト注釈を生成するプロ仕様のプロシージャだ。
コピペしてそのままプロジェクトの標準モジュールに組み込んでほしい。
Option Explicit
Public Sub InsertAnnotationAtLayoutClick()
On Error GoTo ErrorHandler
Dim acadApp As AcadApplication
Dim acadDoc AcadDocument
Set acadApp = ThisDrawing.Application
Set acadDoc = ThisDrawing
‘ 1. 現在の空間がレイアウト（ペーパー空間）であるか検証
If acadDoc.ActiveSpace = acModelSpace Then
MsgBox “このツールはレイアウト空間（ペーパー空間）で実行してください。”, vbExclamation, “空間エラー”
Exit Sub
End If
‘ 2. ユーザーにレイアウト上の点を指示させる
Dim ptLayout As Variant
On Error Resume Next
ptLayout = acadDoc.Utility.GetPoint(, vbCrLf & “モデル空間へ配置する位置をレイアウト上で指定してください: “)
If Err.Number <> 0 Then
‘ ユーザーがESCでキャンセルした場合
Exit Sub
End If
On Error GoTo ErrorHandler
‘ 3. クリックされた位置がどのビューポートに属しているかを判定し、アクティブにする
‘ ※実務ではレイアウト上のすべてのビューポートを走査し、境界ボックス（BBox）でヒットテストを行うのが最も堅牢
Dim targetVPort As AcadPViewport
Set targetVPort = FindViewportAtPoint(acadDoc, ptLayout)
If targetVPort Is Nothing Then
MsgBox “有効なビューポート上を指定してください。”, vbExclamation, “ビューポート未検出”
Exit Sub
End If
‘ ビューポートをアクティブ（モデル空間接続状態）にする
acadDoc.MSpace = True
acadDoc.ActivePViewport = targetVPort
‘ 4. 座標変換の実行 (ペーパー空間 -> モデル空間)
Dim ptModel As Variant
‘ 引数: 座標, 変換元(ペーパー), 変換先(モデル), ディスプレイスメント(False=位置)
ptModel = acadDoc.Utility.TranslateCoordinates(ptLayout, acPaperSpace, acModelSpace, False)
‘ ペーパー空間へ戻す（UIの安全のため）
acadDoc.MSpace = False
‘ 5. 変換されたモデル空間座標にテキスト（注釈）を生成
Dim modelSpaceObj As AcadModelSpace
Set modelSpaceObj = acadDoc.ModelSpace
Dim textObj As AcadText
Dim insertionPoint(0 To 2) As Double
insertionPoint(0) = ptModel(0)
insertionPoint(1) = ptModel(1)
insertionPoint(2) = ptModel(2)
‘ モデル空間上のスケールを考慮した文字高さ（例: 100 mm）で配置
Set textObj = modelSpaceObj.AddText(“【自動配置注釈】”, insertionPoint, 100#)
textObj.Update
MsgBox “モデル空間への座標変換および図形転送が完了しました。” & vbCrLf & _
“X: ” & Format(ptModel(0), “0.00”) & vbCrLf & _
“Y: ” & Format(ptModel(1), “0.00”), vbInformation, “成功”
Exit Sub
ErrorHandler:
‘ 異常終了時のクリーンアップ
On Error Resume Next
acadDoc.MSpace = False
If Err.Number <> 0 Then
MsgBox “予期せぬエラーが発生しました: ” & Err.Description, vbCritical, “致命的エラー”
End If
End Sub
‘ —————————————————————–
‘ ヘルパー関数: 指定されたレイアウト座標（Pt）を含むビューポートを探索する
‘ —————————————————————–
Private Function FindViewportAtPoint(doc As AcadDocument, pt As Variant) As AcadPViewport
Dim pvp As AcadPViewport
Dim minExt As Variant, maxExt As Variant
Dim foundVPort As AcadPViewport
Set foundVPort = Nothing
‘ レイアウト内のペーパー空間エンティティを走査
Dim ent As AcadEntity
For Each ent In doc.PaperSpace
If TypeOf ent Is AcadPViewport Then
Set pvp = ent
‘ ビューポートが有効（ON）かつディスプレイ表示されている場合のみ判定
If pvp.DisplayLocked = False Or pvp.DisplayLocked = True Then ‘ すべての有効なVP対象
pvp.GetBoundingBox minExt, maxExt
‘ 簡易バウンディングボックス判定（実務では厳密なポリゴン判定が望ましいが通常これで十分）
If pt(0) >= minExt(0) And pt(0) <= maxExt(0) And _
pt(1) >= minExt(1) And pt(1) <= maxExt(1) Then
' モデリングビューポート（IDが1のものは全体の枠なので除外するなどの調整が必要な場合あり）
If pvp.objectID <> doc.ActivePViewport.objectID Then
‘ ここでは最初に見つかったビューポートを採用
Set foundVPort = pvp
Exit For
End If
End If
End If
End If
Next ent
‘ 万が一ループで見つからない場合は現在のActivePViewportをフォールバックとして返す
If foundVPort Is Nothing Then
On Error Resume Next
Set foundVPort = doc.ActivePViewport
End If
Set FindViewportAtPoint = foundVPort
End Function
—
4. プロジェクトリーダーからの実践的アドバイス
1. トランザクション管理とエラーハンドリング
上記のコードでは、万が一座標変換の途中で例外が発生しても、確実に `acadDoc.MSpace = False`（ペーパー空間への復帰）が実行されるよう `On Error GoTo ErrorHandler` を厳格に組み込んでいる。これを怠ると、ユーザーの画面がモデル空間に入り込んだままフリーズしたような状態になり、クレームの元となる。
2. データベース連携時の注意点
もしこの座標変換を外部データベース（ExcelやSQLiteなど）からのインポートデータと連動させる場合、図面側の単位設定（`INSUNITS`） との整合性に気をつけよ。モデル空間が「メートル」で、インポートデータが「ミリ」の場合、`TranslateCoordinates` で得た値にさらに係数（1000など）を乗算する必要があるケースが存在する。
座標系の壁を制する者は、AutoCAD自動化を制する。
このロジックをあなたの開発環境に組み込み、圧倒的な精度の業務効率化ツールを完成させてほしい。
