【実務・中級編】【上級プロフェッショナル】AutoCAD VBAで図面内のオブジェクトにカスタムプロパティを自動付与・管理する – AutoCAD VBA解析バイブル

スポンサーリンク

AutoCAD VBAを掌握する極限の知見:図面オブジェクトにカスタムプロパティを宿す「XData」極限活用術

開発現場でよくある要求だ。「線分や円に、独自の『材質』や『管理番号』を持たせたい」「後からそのデータを一括で集計・抽出したい」。

素人が最初に思いつくのは、Excel台帳を別途用意し、CADのハンドル(Handle)やオブジェクトIDと突合させるアプローチだ。しかし、この設計は地獄の始まりを意味する。図面がコピーされ、移動され、編集されるたびにキーがずれ、整合性は一瞬で崩壊する。

「データはオブジェクトと共に生きるべきだ」

AutoCAD VBAにおいて、図面内の幾何학オブジェクトに独自のメタデータを付与し、幾何情報と完全に同期させる唯一にして最強の武器、それが 拡張データ(XData:Extended Data) である。

今回は、現場のプロが即座に導入でき、かつ絶対に破綻しない「XDataマネジメント・ソリューション」の全貌を伝授しよう。

1. なぜ「XData」なのか? オブジェクトモデルの深淵

AutoCADのオブジェクト(`AcadEntity`)は、標準プロパティ(Layer, Colorなど)のほかに、開発者が任意のアプリケーション名を冠した固有のデータ配列を格納できる領域を持っている。それがXDataだ。

従来のハック(非効率な設計)の罠

  • 外部ファイル(CSV/Excel)連携: 図面が別フォルダに移動した瞬間にリンク切れ。論外。
  • 図面レベルのDictionary(`AcadDictionary`): オブジェクトの削除・複写に追従させるためのイベントハンドリング(`AcadDocument_ObjectModified` 等)のコードが複雑化しすぎて、パフォーマンスが著しく低下する。

XDataの優位性

XDataはオブジェクトと一心同体だ。ユーザーが図面上でそのオブジェクトを「コピー」「ミラー」「ストレッチ」しようとも、付与されたカスタムプロパティは完全に追随する。CADのライフサイクル管理において、これほど信頼性の高い仕組みはない。

2. 【実務向け】堅牢なXData管理クラスの設計

XDataを扱う際の最大の壁は、AutoCAD独自の「DXFグループコード(1000〜1071)」による厳格な型指定と、アプリケーション登録の作法(`RegApp`)だ。

ここからは、実務のプロダクション環境でそのまま稼働する、堅牢かつ洗練されたVBAコードを公開する。エラーハンドリングを徹底し、メモリリークや型ミスマッチを完全に排除した設計となっている。

プロダクションコード:`XDataManager.bas`

以下のコードをVBAの標準モジュールにインポート、または貼り付けてほしい。

Option Explicit

‘ ==============================================================================
‘ モジュール名: XDataManager
‘ 概要: AutoCADオブジェクトに対するXDataの書き込み・読み込みをカプセル化
‘ 著者: チーフアーキテクト
‘ ==============================================================================

Private Const APP_NAME As String = “PRJ_METADATA” ‘ 独自のアプリケーション名

”’

”’ 指定したオブジェクトにカスタムプロパティ(材質・管理番号)を付与する
”’

Public Sub SetCustomProperties(ByVal targetEntity As AcadEntity, ByVal material As String, ByVal serialNo As String)
On Error GoTo ErrorHandler

‘ 1. アプリケーション名(RegApp)の事前登録
Call RegisterApplicationName(APP_NAME)

‘ 2. XData格納用の配列を定義 (DXFグループコードの型ルールに厳密に従うこと)
‘ グループコード 1001: アプリケーション名
‘ グループコード 1000: 文字列データ1 (材質)
‘ グループコード 1000: 文字列データ2 (管理番号)
Dim dataTypes(2) As Integer
Dim dataValues(2) As Variant

dataTypes(0) = 1001: dataValues(0) = APP_NAME
dataTypes(1) = 1000: dataValues(1) = material
dataTypes(2) = 1000: dataValues(2) = serialNo

‘ 3. オブジェクトにXDataをセット
targetEntity.SetXData dataTypes, dataValues

Exit Sub

ErrorHandler:
MsgBox “XDataの設定に失敗しました: ” & Err.Description, vbCritical, “XData Error”
End Sub

”’

”’ オブジェクトからカスタムプロパティを読み込む
”’

Public Sub GetCustomProperties(ByVal targetEntity As AcadEntity, ByRef material As String, ByRef serialNo As String)
On Error GoTo ErrorHandler

Dim dataTypes As Variant
Dim dataValues As Variant

‘ 初期化
material = “”
serialNo = “”

‘ XDataの取得を試行
targetEntity.GetXData APP_NAME, dataTypes, dataValues

‘ データが未設定(配列が初期化されていない)場合は抜ける
If IsEmpty(dataValues) Then Exit Sub

‘ 配列の要素数チェック(1001番のアプリ名を含めて3要素あるか)
If UBound(dataValues) >= 2 Then
material = CStr(dataValues(1))
serialNo = CStr(dataValues(2))
End If

Exit Sub

ErrorHandler:
‘ XDataが存在しない場合のエラーは無視してデフォルトを返す
If Err.Number = -2145320939 Then
Resume Next
Else
MsgBox “XDataの取得中にエラーが発生しました: ” & Err.Description, vbCritical, “XData Error”
End If
End Sub

”’

”’ アプリケーション名が未登録の場合に図面に登録するヘルパー
”’

Private Sub RegisterApplicationName(ByVal appName As String)
Dim regAppTable As AcadRegAppTable
Set regAppTable = ThisDrawing.RegAppTable

On Error Resume Next
Dim dummyRegApp As AcadRegApp
Set dummyRegApp = regAppTable.Item(appName)

‘ 存在しない場合は新規作成
If Err.Number <> 0 Then
Err.Clear
Dim newRegApp As AcadRegApp
Set newRegApp = regAppTable.Add(appName)
End If
On Error GoTo 0
End Sub

3. 実践:図面全体から特定プロパティを持つオブジェクトを抽出・編集する

データがオブジェクトに宿ったことで、真価を発揮する。「管理番号が ‘A-001′ のオブジェクトを探してハイライトする」という実務的なユースケースを実装してみよう。

以下のコードを別の標準モジュールに配置して実行してほしい。

Option Explicit

”’

”’ 図面内を走査し、特定の管理番号を持つオブジェクトを検索して選択状態にする
”’

Public Sub SearchAndSelectBySerialNo()
Dim targetSerial As String
targetSerial = InputBox(“検索する管理番号を入力してください:”, “XData検索”, “SN-1005”)

If Trim(targetSerial) = “” Then Exit Sub

Dim ent As AcadEntity
Dim mat As String, sNo As String
Dim matchCount As Long
matchCount = 0

‘ 選択セットの作成(既存の名前付き選択セットがあれば削除)
Dim ss As AcadSelectionSet
On Error Resume Next
Set ss = ThisDrawing.SelectionSets.Item(“XDataSearchSet”)
If Not ss Is Nothing Then ss.Delete
Set ss = ThisDrawing.SelectionSets.Add(“XDataSearchSet”)
On Error GoTo 0

Dim entArray() As AcadEntity
ReDim entArray(0)

‘ モデル空間の全エンティティを走査
For Each ent In ThisDrawing.ModelSpace
Call XDataManager.GetCustomProperties(ent, mat, sNo)

If sNo = targetSerial Then
‘ マッチしたエンティティを動的配列に蓄積
If matchCount > 0 Then ReDim Preserve entArray(matchCount)
Set entArray(matchCount) = ent
matchCount = matchCount + 1
End If
Next ent

‘ 該当オブジェクトが存在する場合は選択セットに追加して画面ズーム
If matchCount > 0 Then
ss.AddItems entArray
MsgBox matchCount & ” 件のオブジェクトが見つかりました。”, vbInformation, “検索完了”

‘ 最初のオブジェクトへズーム(実務的な親切設計)
ThisDrawing.Application.ZoomExtents
Else
MsgBox “該当する管理番号のオブジェクトは見つかりませんでした。”, vbExclamation, “検索結果”
ss.Delete
End If
End Sub

4. チーフアーキテクトからの警鐘:実務運用の注意点

XDataは強力だが、実務の現場で運用する際には以下の鉄則を忘れてはならない。

1. データ容量の限界を知る
XDataは1つのアプリケーションにつき最大16KBという制限がある。CAD図面の中にBOM(部品表)の全データを丸ごと詰め込むような愚行は避けること。あくまで「外部データベース(SQL ServerやAccessなど)の主キー(ID)」や「軽量なメタデータ」を保持するためのポインタとして使うのがアーキテクチャの正解だ。
2. CADバージョン間互換性
古いDXF/DWG形式に書き出す際、カスタムのXDataは保持されるが、AutoCADのバージョンやサードパーティ製CADとのやり取りによってはサニタイズ(消去)されるリスクがある。重要なマスターデータは必ず外部DBと連携させ、XDataは「図面内の高速な空間・属性リンク」として割り切って使うこと。

最後に:自動化の次のステージへ

今回構築した `XDataManager` モジュールをベースにすれば、Excelからの一括プロパティ流し込み、図面納品前のプロパティ抜けチェッカー、さらにはWeb APIやERPとの連携基盤へとスケールさせることができる。

「オブジェクトに意思を持たせる」。
この設計思想を手に入れたあなたにもはや実装できない業務自動化ツールはないはずだ。さっそく明日の開発現場でこのコードを組み込み、圧倒的な生産性の違いを見せつけてほしい。

タイトルとURLをコピーしました