【実務・中級編】【上級プロ向け】DrawingDoc.FindReferencesを用いた参照モデル欠損の事前チェックと自動修復機構 – SolidWorks VBA解析バイブル

スポンサーリンク
スポンサーリンク

【極限の設計論】SolidWorks図面の「参照切れ」を自動修復する自律型エンジンへの昇華

エンジニアリング・オートメーションの世界において、「動くコード」を書くことはスタートラインに過ぎない。我々が目指すべきは、予期せぬ環境変化(ファイルのリネーム、フォルダ構成の変更、サーバー移行)に対して、自律的に判断し、復旧を試みる「レジリエンス(回復力)を備えたシステム」だ。

図面(Drawing)ファイルの自動生成プロセスにおいて、最も業務を停滞させる要因の一つが「参照モデルの欠損」である。リネームされたモデルを探し回る、あるいは手動で参照を貼り直すといった作業は、自動化の思想に対する冒涜と言っても過言ではない。

本稿では、`DrawingDoc.FindReferences` を起点とし、欠損した参照を「AI的な類推(Fuzzy Matching)」によって特定・再アタッチする、プロフェッショナル仕様の修復機構の設計思想と実装を伝授する。

1. なぜ、単純なパスチェックでは不十分なのか

多くの開発者が陥る罠がある。それは「`GetPathName` でパスを取得し、`Dir()` 関数でファイルが存在するか確認する」という、極めて初歩的なチェックだ。

しかし、実務の現場はそんなに甘くない。

  • パスの不一致: サーバーのドライブレターが変わった。
  • ファイル名の微細な変更: `Part_v1.sldprt` が `Part_v1_revA.sldprt` になった。
  • 階層構造の変更: プロジェクト管理ルールにより、サブフォルダに移動された。

これらに対し、完全一致(Exact Match)を前提としたロジックは、即座に「失敗」という名のノイズを量産する。我々に求められるのは、「欠損した情報の断片から、正解を推論する能力」である。

2. アーキテクチャ設計:検知・類推・修復の3フェーズ

堅牢な修復ツールを構築するためには、以下の3つのレイヤーに機能を分離して設計しなければならない。

Phase 1: Detection(欠損の特定)

`DrawingDoc.FindReferences` を用いて、図面が保持している外部参照のリストを走査する。ここで重要なのは、単に「ファイルがない」と判定するだけでなく、「本来あるべきファイル名」をメタデータとして保持することだ。

Phase 2: Heuristic Analysis(類推ロジック)

ここがエンジニアの腕の見せ所だ。欠損したファイル名と、指定された検索ディレクトリ内のファイル群を比較し、レーベンシュタイン距離(Levenshtein Distance)などのアルゴリズムを用いて、最も類似度の高いファイルを特定する。

Phase 3: Execution(修復の実行)

特定したパスを用いて `ReplaceReference` を実行する。この際、単にパスを書き換えるだけでなく、モデルの再読み込み(Reload)と、図面ビューの更新(Rebuild)を確実に行い、整合性を担保する。

3. プロダクション・コード例

以下に、実務でそのまま利用可能なレベルの設計思想を組み込んだVBAコードを示す。
※このコードは、高度な文字列比較(レーベンシュタイン距離)を実装するために、ロジックの核となる部分を凝縮している。

Option Explicit

' ======================================================================================
' Module: DrawingRepairEngine
' Description: 参照切れモデルを類推し、自動修復する高度なエンジン
' Author: Legendary Chief Architect
' ======================================================================================

' 参照設定が必要: 
' - Microsoft Scripting Runtime (Dictionary用)
' - SolidWorks [Type Library]

Public Sub ExecuteSelfHealing()
    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim swDraw As SldWorks.DrawingDoc
    Dim vRefs As Variant
    Dim i As Long
    Dim refPath As String
    Dim refName As String
    Dim searchDir As String
    
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    
    ' 1. 型チェック: 図面ファイルであることの保証
    If swModel Is Nothing Then Exit Sub
    If swModel.GetType <> swDocDRAWING Then
        MsgBox "図面ファイルを開いた状態で実行してください。", vbCritical
        Exit Sub
    End If
    
    Set swDraw = swModel
    
    ' 検索対象となるルートディレクトリ(実務では設定ファイルやDBから取得すべき)
    searchDir = "C:\Project\Models\" 
    
    ' 2. FindReferences による参照走査
    ' FindReferences は、図面が参照しているモデルのパス配列を返す
    vRefs = swDraw.FindReferences
    
    If IsEmpty(vRefs) Then
        Debug.Print "参照が見つかりませんでした。"
        Exit Sub
    End If
    
    Debug.Print "--- 修復プロセス開始 ---"
    
    For i = 0 To UBound(vRefs)
        refPath = vRefs(i)
        
        ' 3. 参照切れの判定
        If Not FileExists(refPath) Then
            refName = GetFileNameFromPath(refPath)
            Debug.Print "【欠損検知】: " & refName
            
            ' 4. 類推アルゴリズムによる修復試行
            Dim bestMatchPath As String
            bestMatchPath = FindBestMatchHeuristic(searchDir, refName)
            
            If bestMatchPath <> "" Then
                ' 5. 修復の実行
                Debug.Print "  -> 【修復成功】: " & bestMatchPath
                If ReplaceDrawingReference(swModel, refPath, bestMatchPath) Then
                    Debug.Print "  -> 参照の再アタッチに成功しました。"
                Else
                    Debug.Print "  -> [Error] 再アタッチに失敗しました。"
                End If
            Else
                Debug.Print "  -> 【修復失敗】: 類似するファイルが見つかりませんでした。"
            End If
        End If
    Next i
    
    ' 最終的な図面の再構築
    swModel.ForceRebuild3 True
    Debug.Print "--- 修復プロセス終了 ---"
End Sub

' --------------------------------------------------------------------------------------
' 関数: FindBestMatchHeuristic
' 概要: 指定ディレクトリ内から、欠損ファイル名に最も近いファイルを類推する
' --------------------------------------------------------------------------------------
Private Function FindBestMatchHeuristic(ByVal dirPath As String, ByVal targetName As String) As String
    Dim fso As New FileSystemObject
    Dim folder As folder
    Dim file As file
    Dim currentFile As String
    Dim bestPath As String
    Dim maxSimilarity As Double
    Dim similarity As Double
    
    ' ディレクトリが存在しない場合は即時終了
    If Not fso.FolderExists(dirPath) Then Exit Function
    
    Set folder = fso.GetFolder(dirPath)
    maxSimilarity = 0
    
    ' 再帰的に検索するか、特定の階層を走査する(ここでは簡易的に直下のみ)
    For Each file In folder.Files
        currentFile = file.Name
        
        ' 類似度計算 (レーベンシュタイン距離を応用した簡易スコアリング)
        ' 本来はここで高度なアルゴリズムを呼び出す
        similarity = CalculateSimilarity(targetName, currentFile)
        
        ' 閾値(例: 0.7)を超えた場合に最高スコアを更新
        If similarity > maxSimilarity And similarity > 0.7 Then
            maxSimilarity = similarity
            bestPath = file.Path
        End If
    Next file
    
    FindBestMatchHeuristic = bestPath
End Function

' --------------------------------------------------------------------------------------
' 関数: CalculateSimilarity
' 概要: 2つの文字列の類似度を 0.0 ~ 1.0 で返す
' --------------------------------------------------------------------------------------
Private Function CalculateSimilarity(ByVal str1 As String, ByVal str2 As String) As Double
    ' ※実務ではここにレーベンシュタイン距離の計算ロジックを実装する
    ' 今回はデモとして、簡易的な部分一致スコアを返す
    Dim len1 As Long, len2 As Long
    len1 = Len(str1)
    len2 = Len(str2)
    
    If InStr(1, str2, str1, vbTextCompare) > 0 Then
        CalculateSimilarity = 1# ' 完全一致または包含
    ElseIf InStr(1, str1, str2, vbTextCompare) > 0 Then
        CalculateSimilarity = 1#
    Else
        ' 簡易的な文字数ベースのスコア
        CalculateSimilarity = 0# 
    End If
End Function

' --------------------------------------------------------------------------------------
' 関数: ReplaceDrawingReference
' 概要: SolidWorks APIを用いて、実際の参照を書き換える
' --------------------------------------------------------------------------------------
Private Function ReplaceDrawingReference(swModel As ModelDoc2, oldPath As String, newPath As String) As Boolean
    On Error GoTo ErrHandler
    
    ' DrawingDoc.ReplaceReference を使用
    ' 引数: (旧パス, 新パス)
    Dim swDraw As DrawingDoc
    Set swDraw = swModel
    
    ' APIの戻り値を確認
    Dim status As Boolean
    status = swDraw.ReplaceReference(oldPath, newPath)
    
    ReplaceDrawingReference = status
    Exit Function

ErrHandler:
    ReplaceDrawingReference = False
End Function

' --- ユーティリティ関数群 ---
Private Function FileExists(path As String) As Boolean
    FileExists = (Dir(path) <> "")
End Function

Private Function GetFileNameFromPath(path As String) As String
    Dim fso As New FileSystemObject
    GetFileNameFromPath = fso.GetFileName(path)
End Function

4. アーキテクトの視点:運用における3つの鉄則

このコードをプロダクション環境(実際の業務システム)に投入する際、以下の3点を必ず設計に組み込んでください。これを行わない限り、ツールは「不安定な魔法」に過ぎません。

① ログの完全な可視化

自動修復は、ユーザーにとって「ブラックボックス」になりがちです。
「どのファイルが、どのファイルに、なぜ(類似度何%で)置き換わったのか」を、CSVまたはデータベースに詳細に記録してください。これは、後日のトラブルシューティングにおいて、唯一の生命線となります。

② 失敗の「閾値」設定

類推ロジックにおいて、類似度が低すぎる(例:0.5以下)場合は、絶対に自動修復を行わず、ユーザーに介入を求める設計にしてください。間違ったモデルをアタッチすることは、図面破壊に直結します。

③ COMオブジェクトのライフサイクル管理

VBAでSolidWorks APIを叩く際、特に大量のファイルを処理する場合は、メモリリークに細心の注意を払ってください。`Set obj = Nothing` を徹底し、エラーハンドリング内でオブジェクトが宙に浮かないよう、堅牢なクリーンアップ処理を実装してください。

結論

`DrawingDoc.FindReferences` を単なる「エラーチェック」として使うのは、プロフェッショナルとは言えません。それは、データの欠落を検知し、高度なロジックによって自律的に整合性を回復させるための、「自己修復エンジン」のトリガーなのです。

設計の深さが、ツールの信頼性を決める。この原則を忘れないでください。

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