【テクニカル・上級編】【実務中級者向け】保存時の「自動ズーム」を特定の注釈エリアに限定する：検図者が最初に見るべき場所を固定してセーブ – AutoCAD VBA解析バイブル

図面の「意図」を保存せよ：検図プロセスを劇的に変える、ビューポート制御による視覚的申し送り術

図面（DWG）とは、単なる幾何学情報の集合体ではない。それは設計者の「意図」を、次の工程の人間へと伝えるための、極めて高度なコミュニケーション・プロトコルである。

しかし、多くの現場ではこのプロトコルが崩壊している。設計者が修正を終えて保存した図面を開いた検図者が、まず行うことは何か？ 「どこが変わったのかを探す」という、極めて非生産的で、認知負荷の高い探索作業である。巨大な図面の中で、数ミリの修正箇所を求めてズームイン・アウトを繰り返す。これは、エンジニアリングの敗北である。

本稿では、AutoCAD VBAを用い、図面内の「変更箇所マーク」を自動検出し、その領域を最適に画面表示（Zoom）した状態で保存する、プロフェッショナルな実装手法を解説する。これは単なる自動化ではない。「情報の送り手」が「受け手」の認知負荷をコントロールするための、設計思想の実装である。

1. アーキテクチャの設計：情報の局所化

本システムを実現するためには、以下の3つのステップを、極めて高い精度で実行する必要がある。

1. ターゲットの特定（Identification）: 特定のレイヤー、あるいは特定のブロック名を持つ「変更マーク」を、図面内から高速に抽出する。
2. 境界領域の計算（Bounding Box Calculation）: 抽出された複数のオブジェクトを包含する、最小の矩形領域（Envelope）を算出する。
3. ビューポートの再定義（Viewport Injection）: 計算された領域に基づき、`ActiveViewport` の `Center` および `Height` を数学的に決定し、視覚的な「焦点」を固定する。

2. 実装における致命的な落とし穴：メモリ管理と座標系

中級者が陥る最大のミスは、`SelectionSets` の適切な破棄を怠ること、そして UCS（ユーザー座標系）とWCS（世界座標系）の混同 である。

`SelectionSets` は、AutoCADのメモリ上に明示的に確保されるリソースである。ループ内でこれを作成し、適切に `Delete` しなければ、数時間の運用でAutoCADは確実にメモリリークを引き起こし、クラッシュする。また、オブジェクトの座標を取得する際は、常にWCSに基づいた計算を行う必要がある。さもなくば、ズーム位置は設計者の意図から遥か遠くへ逸脱するだろう。

3. 極限のコード実装：SmartZoom-to-Mark

以下に、実務に耐えうる堅牢なコードを示す。このコードは、特定のレイヤー（例: `”CHANGE_MARK”`）に存在するすべてのオブジェクトを検索し、それらを包含する領域へ自動的にズームし、図面を保存する。

Option Explicit

' ==============================================================================
' Module: DrawingHandoverOptimizer
' Description: 特定の注釈エリアを検出し、ビューポートを最適化して保存する
' Author: Legendary Chief Architect
' ==============================================================================

Public Sub SaveWithSmartZoom()
    Dim acadDoc As AcadDocument
    Set acadDoc = ThisDrawing
    
    ' ターゲットとなるレイヤー名（実務に合わせて変更）
    Const TARGET_LAYER As String = "CHANGE_MARK"
    ' ズーム時の余白係数（1.2 = 20%の余裕を持たせる）
    Const MARGIN_FACTOR As Double = 1.2
    
    Dim ss As AcadSelectionSet
    Dim obj As AcadEntity
    Dim minPt As Variant, maxPt As Variant
    Dim centerX As Double, centerY As Double
    Dim viewHeight As Double, viewWidth As Double
    Dim foundCount As Integer
    
    ' 1. エラーハンドリングと既存SelectionSetsのクリーンアップ
    On Error Resume Next
    Set ss = acadDoc.SelectionSets.Item("SS_CHANGE_MARKS")
    If Err.Number = 0 Then
        ss.Delete
    End If
    On Error GoTo ErrorHandler
    
    ' 2. SelectionSetの作成とフィルタリング
    ' フィルタリングにより、全オブジェクトをループする無駄を省き、計算負荷を最小化する
    Set ss = acadDoc.SelectionSets.Add("SS_CHANGE_MARKS")
    ss.SelectOnScreen ' または ss.Select vbSelectionSetAll, , , filterArray
    
    ' ※実務では SelectOnScreen ではなく、以下のようにフィルタを使用することを推奨
    ' フィルタリングの構成（レイヤー指定）
    Dim filterType(0) As Integer
    Dim filterData(0) As Variant
    filterType(0) = aclayer
    filterData(0) = TARGET_LAYER
    
    ss.Select acSelectionSetAll, , , filterType, filterData

    foundCount = ss.Count
    If foundCount = 0 Then
        MsgBox "変更箇所マークが見つかりませんでした。通常の保存を行います。", vbInformation
        acadDoc.Save
        GoTo Cleanup
    End If

    ' 3. 境界領域（Bounding Box）の計算
    ' 複数のオブジェクトを包摂する最小の矩形を求める
    Dim minX As Double, minY As Double, maxX As Double, maxY As Double
    Dim firstIteration As Boolean: firstIteration = True
    
    For Each obj In ss
        minPt = obj.GetBoundingBox(minPt, maxPt) ' WCSでの座標取得
        
        Dim curMinX As Double: curMinX = minPt(0)
        Dim curMinY As Double: curMinY = minPt(1)
        Dim curMaxX As Double: curMaxX = maxPt(0)
        Dim curMaxY As Double: curMaxY = maxPt(1)
        
        If firstIteration Then
            minX = curMinX: minY = curMinY: maxX = curMaxX: maxY = curMaxY
            firstIteration = False
        Else
            If curMinX < minX Then minX = curMinX
            If curMinY < minY Then minY = curMinY
            If curMaxX > maxX Then maxX = curMaxX
            If curMaxY > maxY Then maxY = curMaxY
        End If
    Next obj

    ' 4. ビューポートの計算と適用
    ' 中心点と、表示すべき高さ（Height）を算出
    centerX = (minX + maxX) / 2#
    centerY = (minY + maxY) / 2#
    
    ' 画面に収まるよう、高さと幅の大きい方に合わせる（アスペクト比考慮）
    Dim diffX As Double: diffX = maxX - minX
    Dim diffY As Double: diffY = maxY - minY
    
    ' 画面のアスペクト比を取得して、ズームの歪みを防ぐ
    Dim viewPort As AcadViewport
    Set viewPort = acadDoc.ActiveViewport
    
    ' 計算された矩形にマージンを加味
    viewHeight = diffY * MARGIN_FACTOR
    
    ' 描画更新を最小限に抑えるため、最後に一括適用
    ' ViewCenterとViewHeightを直接操作する
    acadDoc.ZoomCenter centerX, centerY, viewHeight / (viewPort.AspectRatio)
    ' ※注: ZoomCenterは簡易的な手法。より厳密には Viewportオブジェクトの直接操作を行う。
    ' 今回は安定性を重視し、標準的なZoomメソッドを使用。
    
    ' 5. 保存の実行
    acadDoc.Save
    MsgBox "変更箇所を最適化した状態で保存しました。", vbInformation

Cleanup:
    ' 6. メモリ解放（極めて重要）
    On Error Resume Next
    If Not ss Is Nothing Then
        ss.Delete
        Set ss = Nothing
    End If
    Exit Sub

ErrorHandler:
    MsgBox "致命的なエラーが発生しました: " & Err.Description, vbCritical
    Resume Cleanup
End Sub

4. アーキテクトの視点：さらなる高度化への道

上記のコードは実務における「標準」であるが、極限のパフォーマンスを求めるならば、以下の拡張を検討すべきである。

A. 非同期処理とUIの分離

大規模な図面で数万個のオブジェクトを走査する場合、AutoCADのメインスレッドをブロックしてしまう。もしこれが社内共通のアドインとして配布されるなら、計算ロジックを分離し、ユーザーに「処理中」であることを示すプログレスバーを表示する設計が求められる。

B. Windows APIによるウィンドウフォーカスの強制

`acadDoc.Save` を実行した後、AutoCADがバックグラウンドに回ってしまうケースがある。検図者が即座に作業に移れるよう、Windows API (`SetForegroundWindow`) を用いて、確実にAutoCADのウィンドウを最前面に持ってくる制御を組み込むことで、ユーザー体験（UX）は極限まで高まる。

C. 複数ビューポートへの対応

レイアウト空間（Paper Space）におけるビューポートの制御は、モデル空間とは全く異なるロジックが必要となる。実務においては、モデル空間だけでなく、各レイアウト上のビューポートに対しても、同様の「注釈へのフォーカス」を適用するマルチレイヤー戦略が有効である。

結論

「どこを見ればいいのか」を、図面自体が語りかける。
この自動化テクニックは、単なる作業の効率化ではない。設計、検図、製造という一連の情報の連鎖において、情報の解像度を維持し、伝達ロスを最小化するための、エンジニアリング・インテグリティ（技術的誠実さ）の現れである。

優れたシステムは、人間のミスを防ぐだけでなく、人間の「思考の質」を高めるために存在する。