【上級】Shape.SpatialRelationを活用した空間検索エンジン：指定範囲内の図形を高速抽出する
Visio VBAにおける空間計算の多くは、未だに泥臭い「座標の四則演算」で行われている。`PinX`、`PinY`、`Width`、`Height`を取得し、境界ボックス（Bounding Box）の交差判定を自前のVBAコードでループさせる――。
もし、あなたが数百、数千のシェイプを持つ図面でそれをやっているなら、今すぐそのロジックを捨てるべきだ。VBAのインタープリター上でループを回す座標計算は遅く、図形の回転（Angle）や複雑なジオメトリを考慮した途端に破綻する。
Visioの内部には、C++で最適化された強靭な空間検索エンジンがネイティブ実装されている。それが `Shape.SpatialRelation` メソッドだ。このメソッドを完全に掌握すれば、VBAの非力さを補って余りある、ミリ秒単位の高速空間クエリシステムを構築できる。
今回は、この `SpatialRelation` を武器に、指定した仮想領域（バウンディングエリア）や特定シェイプの周囲に存在するオブジェクトをノータイムで抽出する、極限の空間検索エンジンを実装する。
—
1. SpatialRelation メソッドの深層とアーキテクチャの真実
`Shape.SpatialRelation` は、2つのシェイプ間、あるいはシェイプと「任意の幾何学領域」の空間的関係を評価する。
result = shape1.SpatialRelation(shape2, tolerance, flags)
このメソッドの真価は、単なる「重なり判定」にとどまらない点にある。引数に渡す `flags`（定数：`VisSpatialRelationFlags`）と `tolerance`（許容値：通常は内部単位で 0.0～）を適切に制御することで、幾何学的包含、接触、近接（バッファリング）をVisioのC++コアエンジンに一瞬で計算させることができる。
0.1mmの罠：内部単位（Inches / DPC）の厳守
Visioのオブジェクトモデルは、画面上の表示単位（mmやpt）に惑わされてはならない。すべての座標計算と `tolerance` は、内部単位である インチ（Inches） で処理される。ミリメートルをそのまま渡せば、検索範囲が狂い、エンジンは機能不全に陥る。変換関数（`Visio.Application.ConvertResult` または自前の算術）を挟むのがプロの作法だ。
—
2. 実装：指定領域内のシェイプを秒速で抽出する空間検索エンジン
ここでは、特定の「矩形エリア（仮想領域）」を定義し、その内部、または部分的に接触しているすべてのシェイプをページ内から高速抽出する実用モジュールを提示する。
実務において、検索対象のページから毎回全シェイプを走査するのはメモリとCPUの無駄遣いだ。あらかじめ「検索用の不可視（または特定のレイヤーの）矩形シェイプ」を一時的に生成し、それを空間クエリのプローブ（探針）として利用する手法が最も堅牢かつ高速である。
Option Explicit
‘ ==============================================================================
‘ módulo: SpatialSearchEngine
‘ 概要: 指定された矩形座標内に存在するシェイプを高速抽出する
‘ ==============================================================================
Public Sub RunSpatialQuerySample()
Dim vsoPage As Visio.Page
Set vsoPage = ActivePage
‘ 検索領域の定義（ミリメートル単位で指定し、内部でインチに変換）
‘ 例: 左上 (10mm, 100mm) から 右下 (100mm, 20mm) の矩形エリア
Dim minX As Double, minY As Double, maxX As Double, maxY As Double
minX = 10: minY = 20: maxX = 100: maxY = 100
Dim targetShapes As Visio.Selection
Set targetShapes = FindShapesInRectangle(vsoPage, minX, minY, maxX, maxY)
‘ 結果の出力
Debug.Print “— 空間検索結果: ” & targetShapes.Count & ” 個のシェイプを検知 —”
Dim shp As Visio.Shape
For Each shp in targetShapes
Debug.Print ” ID: ” & shp.ID & ” | Name: ” & shp.Name & ” | Text: ” & Left(shp.Text, 20)
(Next shp
‘ ※メモリの明示的解放（後述）についてはVBAのCOMラッパー特性に注意
End Sub
‘ ——————————————————————————
‘ 指定矩形内のシェイプを高精度・高速に抽出するコア関数
‘ ——————————————————————————
Public Function FindShapesInRectangle(vsoPage As Visio.Page, _
ByVal mmLeft As Double, ByVal mmBottom As Double, _
ByVal mmRight As Double, ByVal mmTop As Double) As Visio.Selection
Dim app As Visio.Application
Set app = vsoPage.Application
‘ 1. 座標をVisio内部単位（インチ）へ変換
Dim inLeft As Double, inBottom As Double, inRight As Double, inTop As Double
inLeft = app.ConvertResult(mmLeft, visMillimeters, visInches)
inBottom = app.ConvertResult(mmBottom, visMillimeters, visInches)
inRight = app.ConvertResult(mmRight, visMillimeters, visInches)
inTop = app.ConvertResult(mmTop, visMillimeters, visInches)
‘ 2. 検索用のプローブ（一時矩形シェイプ）をページ上に作成
‘ ※非表示レイヤーに配置するか、処理後に即座に削除する
Dim w As Double, h As Double, pinX As Double, pinY As Double
w = inRight – inLeft
h = inTop – inBottom
pinX = inLeft + (w / 2#)
pinY = inBottom + (h / 2#)
Dim vsoProbeShape As Visio.Shape
Set vsoProbeShape = vsoPage.DrawRectangle(inLeft, inTop, inRight, inBottom)
‘ 画面描画の凍結により、一時シェイプの生成・削除によるフリッカーと描画コストを排除
app.ScreenUpdating = False
On Error GoTo ErrorHandler
Dim vsoSelection As Visio.Selection
Set vsoSelection = vsoPage.CreateSelection(visSelTypeEmpty)
Dim vsoShape As Visio.Shape
Dim spatialResult As Integer
‘ 3. ページ内の全シェイプに対して SpatialRelation を実行
‘ フラグ設定:
‘ visSpatialContainedInside (完全に内部にある)
‘ visSpatialOverlap (部分的に重なっている)
‘ visSpatialTouching (境界が接している)
Const SEARCH_FLAGS As Long = VisSpatialRelationFlags.visSpatialContainedInside Or _
VisSpatialRelationFlags.visSpatialOverlap Or _
VisSpatialRelationFlags.visSpatialTouching
Dim tolerance As Double
tolerance = 0.0001 ‘ 許容誤差（実質ゼロ）
For Each vsoShape In vsoPage.Shapes
‘ プローブ自身は除外
If vsoShape.ID <> vsoProbeShape.ID Then
‘ ガイドや不可視要素を除外したい場合はここでシェイプタイプやレイヤーをフィルタリングする
If vsoShape.Type <> VisShapeTypes.visTypeGuide Then
spatialResult = vsoProbeShape.SpatialRelation(vsoShape, tolerance, SEARCH_FLAGS)
‘ 関係性が条件に合致した場合、セレクションに追加
‘ (SpatialRelationは条件を満たす場合に非ゼロを返す)
If spatialResult <> 0 Then
vsoSelection.Select vsoShape, visSelect
End If
End If
End If
Next vsoShape
‘ 4. プローブシェイプの消去
vsoProbeShape.Delete
app.ScreenUpdating = True
Set FindShapesInRectangle = vsoSelection
Exit Function
ErrorHandler:
‘ 異常終了時のクリーンアップ
On Error Resume Next
If Not vsoProbeShape Is Nothing Then vsoProbeShape.Delete
app.ScreenUpdating = True
Set FindShapesInRectangle = Nothing
MsgBox “空間検索エンジンの実行中に致命的なエラーが発生しました: ” & Err.Description, vbCritical
End Sub
—
3. シニアエンジニアが知るべき「メモリ最適化」と「COMの罠」
VBAにおけるVisio開発で最も見落とされがちなのが、COMオブジェクトのライフサイクル管理とメモリリークだ。
ループ内でのオブジェクト生成と参照解放の鉄則
上記のコードにおいて、`For Each vsoShape In vsoPage.Shapes` のループ内や、頻繁に呼び出されるサブルーチン内で暗黙的なCOMオブジェクトの生成が行われる場合、VBAの裏側ではRCW（Runtime Callable Wrapper）やCOM参照カウンタがインクリメントされ続ける。
大規模な図面（シェイプ数5,000以上）を対象にこのエンジンを回すと、ガベージコレクションが追いつかずにメモリ消費量が跳ね上がり、最悪の場合ExcelやVisioプロセスがクラッシュする。
対策:
1. ループ変数として使用するオブジェクト（`vsoShape` など）は、スコープを適切に保ち、ループの反復ごとに不要な参照を保持させない。
2. `Visio.Selection` オブジェクトや一時シェイプは、使い捨てのアーキテクチャを徹底し、処理終了時には確実に破棄する。
3. `Application.ScreenUpdating = False` は、描画コストの削減だけでなく、形状変更に伴うイベント（`ShapeAdded` や `ShapeChanged`）の無駄な発火を防ぎ、メモリ空間をクリーンに保つ防壁としても機能する。
—
4. レガシー環境・外部システム連携への応用
この `SpatialRelation` を活用した空間検索エンジンは、単なる図面内検索にとどまらない。
- CAD図面やP&IDの自動検証システム:
配管（ライン）を表すシェイプが、特定のバルブや機器（ポンプ・タンク）の判定領域（バッファ）内に正しく「接触・接続」しているかを、座標の目視ではなく空間関係フラグで厳密に自動監査する。
- Web/デスクトップ連携（C# / VSTO アーキテクチャへの移行ブリッジ）:
将来的にこのVBAロジックをCOM Add-in（C# / VB.NET）へ移植する際も、`Shape.SpatialRelation` の概念（`Visio.Shape.SpatialRelation`）はそのままC#側の互換APIとして動作する。VBA層でこのアルゴリズムの確実性を実証しておけば、将来の.NET移行コストを劇的に削減できる。
総括
座標の大小比較をこねくり回す時代は終わった。Visioというアプリケーションのコアが持つ幾何学エンジンに直接問いかけること。それこそが、レガシーなVBA環境であっても「モダンで堅牢なエンタープライズ品質」を実現する唯一の道である。
真のエンジニアであれ。コードの背後にあるエンジンを動かせ。
