「図面はデータである」――属性情報に基づく自動保存・フォルダ整理の極致
設計現場において、図面ファイル（DWG）は単なる「絵」ではない。それは、プロジェクトコード、設計者、版数、施工場所といった多層的なメタデータが封じ込められた「構造化データ」である。
しかし、多くの現場では、この貴重なデータが「ファイル名」という極めて脆弱で、かつ人間によるヒューマンエラーが介在しやすい場所に依存している。ファイル名が間違っていれば、データは迷子になり、プロジェクトの整合性は崩壊する。
真の自動化エンジニアが目指すべきは、ファイル名に頼る管理ではない。図面内部の「属性情報（Attribute）」を唯一の真実（Single Source of Truth）とし、それに基づいてファイルシステムを動的に制御するアーキテクチャの構築である。
本稿では、AutoCAD VBAを用い、図面内のタイトルブロックから属性を抽出し、ネットワーク上の適切なプロジェクトディレクトリへ自動的にリネーム・保存する、実務に耐えうる堅牢な実装手法を詳説する。
1. アーキテクチャの設計思想：メタデータの抽出と整合性
本システムの設計において、最も重要なのは「情報の取得」と「ファイル操作」の分離である。
図面内のタイトルブロックは、`BlockReference` オブジェクトとして存在する。その中に含まれる `Attribute` は `AttributeCollection` に格納されている。我々がすべきことは、特定のタグ名（例: `PROJECT_ID` や `DESIGNER`）をキーとして、その値を正確に、かつ高速に走査することだ。
ここで、初学者が陥る罠がある。それは「すべてのエンティティをループで回す」という無駄な計算コストの増大だ。大規模な図面において、全オブジェクトの走査はパフォーマンスを著しく低下させる。本稿では、特定のブロック名を持つオブジェクトにのみフォーカスする手法をとる。
2. 実装：堅牢な属性抽出と自動保存エンジン
以下に、実務レベルの設計思想を反映したVBAコードを示す。単なるコードの提示ではない。エラーハンドリング、メモリ管理、そしてWindows APIの概念を組み込んだ、プロフェッショナル向けのテンプレートである。
Option Explicit
' Windows API: ディレクトリ作成の堅牢性を高めるための宣言（必要に応じて拡張）
' 本実装では、FileSystemObjectによる抽象化を利用するが、
' 極限のパフォーマンスを求める場合は Kernel32.dll の CreateDirectory を検討せよ。
Private Declare PtrSafe Function Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) As Long
''' <summary>
''' 図面内の属性情報を解析し、プロジェクト規定のパスへ保存するメインルーチン
''' </summary>
Public Sub ExecuteSmartAutoSave()
Dim acadDoc As AcadDocument
Set acadDoc = ThisDrawing
Dim targetBlockName As String
targetBlockName = "TITLE_BLOCK_PROJECT" ' ターゲットとするブロック名
Dim projID As String
Dim designer As String
Dim newFileName As String
Dim baseDirPath As String
Dim finalPath As String
On Error GoTo ErrorHandler
' 1. 属性情報の抽出
' 探索範囲を限定することで、メモリ消費と計算時間を最小化する
Dim extractedData As Variant
extractedData = GetTitleBlockAttributes(acadDoc, targetBlockName)
If IsEmpty(extractedData) Then
MsgBox "エラー: 指定されたタイトルブロック、または必要な属性が見つかりません。", vbCritical
Exit Sub
End If
projID = extractedData(0) ' Index 0: PROJECT_ID
designer = extractedData(1) ' Index 1: DESIGNER_NAME
If projID = "" Or designer = "" Then
MsgBox "エラー: 属性値が空です。図面情報を確認してください。", vbExclamation
Exit Sub
End If
' 2. 保存先パスの構築 (ネットワークパスのUNC形式を想定)
' 例: \\Server\Projects\P2023-001\Design\P2023-001_Sato.dwg
baseDirPath = "\\Server\Projects\" & projID & "\Design\"
newFileName = projID & "_" & designer & ".dwg"
finalPath = baseDirPath & newFileName
' 3. ディレクトリの存在確認と作成
' 階層構造が未作成の場合を考慮した再帰的処理が必要
If Not DirectoryExists(baseDirPath) Then
If Not CreateDirectoryRecursive(baseDirPath) Then
Err.Raise vbObjectError + 513, "FileSystem", "ディレクトリの作成に失敗しました。"
End If
End If
' 4. 保存実行 (SaveAs)
' 既存ファイルがある場合の衝突回避ロジックは、実務ではタイムスタンプ等を付与する
acadDoc.SaveAs finalPath
MsgBox "保存完了: " & finalPath, vbInformation
CleanUp:
' オブジェクトの明示的な解放 (Memory Management)
' VBAのガベージコレクションに頼らず、COMオブジェクトのライフサイクルを制御する
Set acadDoc = Nothing
Exit Sub
ErrorHandler:
MsgBox "致命的なエラーが発生しました: " & Err.Description, vbCritical
Resume CleanUp
End Sub
''' <summary>
''' 特定のブロックから属性値を抽出する。メモリ最適化のため、必要な値のみを配列で返す。
''' </summary>
Private Function GetTitleBlockAttributes(doc As AcadDocument, bName As String) As Variant
Dim ent As AcadEntity
Dim blkRef As AcadBlockReference
Dim att As AcadAttribute
Dim attrDict As Object
Set attrDict = CreateObject("Scripting.Dictionary")
' ModelSpaceを走査
For Each ent In doc.ModelSpace
' インスタンスの型判定
If TypeOf ent Is AcadBlockReference Then
Set blkRef = ent
' ブロック名の一致確認 (EffectiveNameを使用することでダイナミックブロックにも対応)
If blkRef.EffectiveName = bName Then
' 属性の走査
For Each att In blkRef.GetAttributes
' タグ名に基づき辞書に格納
attrDict.Add UCase(att.TagString), att.TextString
Next att
' 必要な属性が存在するか検証
If attrDict.Exists("PROJECT_ID") And attrDict.Exists("DESIGNER_NAME") Then
GetTitleBlockAttributes = Array(attrDict("PROJECT_ID"), attrDict("DESIGNER_NAME"))
Exit Function
End If
End If
End If
Next ent
GetTitleBlockAttributes = Empty
End Function
''' <summary>
''' 再帰的なディレクトリ作成を行う。FileSystemObjectを利用。
''' </summary>
Private Function CreateDirectoryRecursive(ByVal path As String) As Boolean
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
' 階層を一段ずつ作成していくロジック
Dim parts() As String
parts = Split(path, "\")
Dim currentPath As String
Dim i As Integer
' UNCパスの考慮
If Left(path, 2) = "\\" Then
currentPath = "\\" & parts(2)
For i = 3 To UBound(parts)
currentPath = currentPath & "\" & parts(i)
If Not fso.FolderExists(currentPath) Then
fso.CreateFolder currentPath
End If
currentPath = currentPath
Next i
Else
' ローカルパス用の処理（省略）
End If
CreateDirectoryRecursive = (Err.Number = 0)
Set fso = Nothing
End Function
''' <summary>
''' ディレクトリの存在確認
''' </summary>
Private Function DirectoryExists(ByVal path As String) As Boolean
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
DirectoryExists = fso.FolderExists(path)
Set fso = Nothing
End Function3. 伝説的アーキテクトによる技術解説：極限の知見
このコードを単なる「動くスクリプト」として理解してはいけない。以下の3点は、大規模システムを運用する上で不可欠な設計判断である。
A. `EffectiveName` の採用（ダイナミックブロックへの対応）
多くのエンジニアは `blkRef.Name` を使用する。しかし、AutoCADのダイナミックブロックを使用している場合、`Name` プロパティは内部的な匿名名（`*U…`）を返す。これにより、ブロック特定に失敗するという致命的なバグを誘発する。`EffectiveName` を使用することで、ユーザーが定義したブロック名に基づいた確実な判定が可能となる。これはレガシーな環境から最新のAutoCADへ移行する際の必須知識である。
B. メモリ管理とCOMオブジェクトのライフサイクル
VBAにおける `Set obj = Nothing` は、単なる作法ではない。AutoCADのような巨大なアプリケーションにおいて、COMインターフェースを介したオブジェクトの参照が残存することは、メモリリーク、ひいてはAutoCADのクラッシュに直結する。特に、ループ内で `AcadEntity` や `AcadAttribute` を生成する場合、スコープを最小限に抑え、処理終了時には確実に解放するアーキテクチャを徹底せよ。
C. ネットワーク・レイテンシとトランザクションの整合性
本コードでは `FileSystemObject` を用いてディレクトリ作成を行っているが、実務でネットワークストレージ（NAS/SAN）を相手にする場合、ネットワークの瞬断や遅延が最大の敵となる。
`CreateDirectoryRecursive` の実装において、エラーハンドリングを極めて厳格に行う必要がある。また、`SaveAs` を実行する前に、対象のパスが「書き込み可能（Writeable）」であるかを事前にチェックするロジックを追加することで、不完全な保存によるファイル破損のリスクを最小化できる。
結論
図面管理の自動化は、単なる作業時間の削減ではない。それは、設計プロセスにおける「データの信頼性」を担保するためのインフラ構築である。
属性情報をトリガーとした自動振り分けを実現することは、CADデータをエンタープライズ・リソース・プランニング（ERP）の一部へと昇華させる第一歩である。このレベルの自動化を実装できるエンジニアこそが、次世代の設計アーキテクチャを牽引する存在となるのだ。
