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

SolidWorks VBA

2026.11.03

【上級プロ向け】図面の「参照切れ」を自動で救え！`FindReferences` を使いこなす堅牢な修復エンジンの構築術

【上級プロ向け】図面の「参照切れ」を自動で救え！`FindReferences` を使いこなす堅牢な修復エンジンの構築術

こんにちは。技術の荒波を共に乗り越える仲間として、今日は少し「踏み込んだ」話をしましょう。

SolidWorksで図面（Drawing）を扱っているとき、こんな経験はありませんか？
「モデルのファイル名を変更しただけで、図面を開くたびに『参照が見つかりません』という警告が出る……」
「大量の図面を整理したら、どこにどのモデルがあるか分からなくなり、図面が真っ白になってしまった……」

手動で一つずつ「参照先を指定」し直す作業は、エンジニアの貴重な時間を奪う「もっとも避けるべき非生産的な作業」です。これを自動化できれば、あなたは単なる「マクロ利用者」から、システムを設計する「アーキテクト」へと進化できます。

今日は、SolidWorks APIの中でも非常に強力、かつ少し癖のある `DrawingDoc.FindReferences` を使い、壊れたリンクを自動で見つけ出し、まるでAIのように「これのことですよね？」と推測して修復する、堅牢なロジックの作り方を伝授します。

1. なぜ「参照切れ」は起きるのか？ — オブジェクトの絆を理解する

まず、プログラミングの基礎として「SolidWorksがファイルをどう見ているか」を理解しましょう。

図面ファイル（`.slddrw`）は、それ自体に3D形状を持っているわけではありません。図面は、モデルファイル（`.sldprt` や `.sldasm`）への「住所（パス）」をメモしているだけの「案内板」なのです。

正常な状態： 案内板に「Aさんは東京都千代田区に住んでいます」と書かれている。
参照切れの状態： Aさんが引っ越して、案内板が「Aさんは……（空欄）」となっている。

VBAでこの「空欄」を検知し、新しい住所を自動で書き込む。これが今回のミッションです。

2. 核心となる武器：`FindReferences` メソッド

図面内のすべての参照を走査するためのコマンドが `DrawingDoc.FindReferences` です。

このメソッドを呼び出すと、図面が「どのモデルを参照しているか」のリストを、オブジェクトの配列として返してくれます。

ここがプロの視点！

初心者は「マクロの記録」で、ボタンを押したときの動きだけを追います。しかし、プロは「戻り値（Return Value）の型」に注目します。`FindReferences` が返すのは単なるファイル名ではなく、`ModelDoc2` オブジェクトの集合体です。これにより、ファイルが消えていても、その「かつての正体」をプログラム的に特定できるのです。

3. 実践：自動修復エンジンの設計図

ただ「探す」だけでは不十分です。プロのツールには以下の3ステップが必要です。

1. 検知 (Detection): `FindReferences` で参照をリストアップし、ファイルが実際に存在するかチェックする。
2. 推論 (Heuristic Search): ファイルがなければ、ファイルシステムをスキャンして「名前が似ているファイル」や「同じフォルダにあるファイル」を探し出す。
3. 再接続 (Re-attachment): 見つかった新しいパスを `ReplaceReference` メソッドで図面に叩き込む。

それでは、魂を込めたコードを見ていきましょう。

'**
' Module: DrawingRepairEngine
' Description: 図面の参照切れを検知し、名前ベースで自動修復を試みる高度なツール
' Author: Legendary Chief Architect
'**

Option Explicit

Sub RepairDrawingReferences()
    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim swDraw As SldWorks.DrawingDoc
    Dim vRefs As Variant
    Dim i As Long
    Dim swRefModel As SldWorks.ModelDoc2
    Dim oldPath As String
    Dim oldFileName As String
    Dim newPath As String
    
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    
    ' 1. 図面ファイルが開かれているかチェック
    If swModel Is Nothing Or swModel.GetType <> swDocDRAWING Then
        MsgBox "図面ファイルを開いた状態で実行してください。", vbExclamation
        Exit Sub
    End If
    
    Set swDraw = swModel
    
    ' 2. FindReferencesを実行して参照リストを取得
    ' vRefsには、図面が参照しているModelDoc2オブジェクトの配列が入る
    vRefs = swDraw.FindReferences
    
    If IsEmpty(vRefs) Then
        MsgBox "参照が見つかりませんでした。すべて正常です。", vbInformation
        Exit Sub
    End If
    
    Debug.Print "--- 修復プロセス開始 ---"
    
    ' 3. 参照リストを一つずつ走査
    For i = 0 To UBound(vRefs)
        Set swRefModel = vRefs(i)
        
        ' 注意：参照が完全に切れている場合、swRefModelがNothingになるケースがあるためチェック
        If Not swRefModel Is Nothing Then
            oldPath = swRefModel.GetPathName
            
            ' ファイルが物理的に存在するか確認
            If Dir(oldPath) = "" Then
                ' --- 参照切れ発見！ ---
                oldFileName = Mid(oldPath, InStrRev(oldPath, "\") + 1)
                Debug.Print "欠損発見: " & oldFileName
                
                ' 4. 【推論フェーズ】AI的なアプローチ（ここでは簡易的なファイル検索）
                ' 本来はここで、特定のサーバーやプロジェクトフォルダ内を再帰的に検索する
                newPath = SearchForNewFile(swApp, oldFileName)
                
                If newPath <> "" Then
                    ' 5. 【修復フェーズ】新しいパスで上書き
                    ' ReplaceReference メソッドで、図面のリンクを書き換える
                    swDraw.ReplaceReference oldPath, newPath
                    Debug.Print "修復成功: " & oldFileName & " -> " & newPath
                Else
                    Debug.Print "修復失敗: " & oldFileName & " の代替ファイルが見つかりません。"
                End If
            End If
        End If
    Next i
    
    ' 画面を更新して結果を反映
    swModel.ForceRebuild3 True
    MsgBox "修復プロセスが完了しました。詳細はイミディエイトウィンドウを確認してください。", vbInformation
End Sub

'**
' Function: SearchForNewFile
' Description: ファイル名をもとに、指定されたディレクトリ内から類似ファイルを探す
'**
Private Function SearchForNewFile(swApp As SldWorks.SldWorks, targetFileName As String) As String
    ' ここではデモ用に、図面と同じフォルダ内を探すロジックを実装しています
    ' 実務では、ネットワークドライブのルートなどを検索対象に含めます
    
    Dim swModel As SldWorks.ModelDoc2
    Dim currentDocPath As String
    Dim searchDir As String
    Dim fso As Object
    Dim folder As Object
    Dim file As Object
    
    Set swModel = swApp.ActiveDoc
    currentDocPath = swModel.GetPathName
    searchDir = Left(currentDocPath, InStrRev(currentDocPath, "\"))
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' フォルダが存在するか確認
    If fso.FolderExists(searchDir) Then
        Set folder = fso.GetFolder(searchDir)
        
        ' フォルダ内のファイルをスキャン
        For Each file In folder.Files
            ' ファイル名が一致、あるいは拡張子が同じで名前が似ているか判定
            ' ここでは単純に「名前が一致しているか」で判定
            If LCase(file.Name) = LCase(targetFileName) Then
                SearchForNewFile = file.Path
                Exit Function
            End If
        Next
    End If
    
    ' 見つからなかった場合は空文字を返す
    SearchForNewFile = ""
End Function

4. 陥りやすい落とし穴：アーキテクトの警告

このコードを実戦投入する前に、以下の3点を必ず覚えておいてください。これを知っているかどうかが、マクロ作成者とプロの差です。

① オブジェクトのライフサイクル

`FindReferences` で取得したオブジェクトをループ内で操作するとき、参照の書き換え（`ReplaceReference`）を行うと、ループのインデックスやオブジェクトの整合性が崩れることがあります。
対策: 大規模な図面では、一度「欠損しているパスのリスト」を配列にすべて抽出してから、別のループで修復処理を行う「2パス方式」が最も安全です。

② パフォーマンスの重み

`SearchForNewFile` 関数の中で、ネットワークドライブ全体を `FileSystemObject` でスキャンするのは絶対に避けてください。数万個のファイルをスキャンすると、SolidWorksがフリーズしたようになります。
対策: 検索範囲を「プロジェクトフォルダ」や「特定の共有ディレクトリ」に限定する、あるいは事前にファイルリストをインデックス化しておく設計が必要です。

③ エラーハンドリングの重要性

「ファイルは見つかったけれど、実は破損していた」というケースがあります。
対策: `ReplaceReference` の後に、そのモデルが正常に開けるか、あるいは `swModel.GetErrors` でエラーが出ていないかをチェックする工程を入れると、ツールとしての信頼性が爆上がりします。

最後に：君はもう、マクロの記録者ではない

ここまで読んでくれたあなたは、単に「動くコード」を書く段階を通り越し、「システムの堅牢性」を考える段階に足を踏み入れました。

`FindReferences` を使いこなし、エラーを予見し、自動で修復する。この考え方は、SolidWorksに限らず、あらゆるITエンジニアリングに通じる本質的なスキルです。

最初はエラーが出るかもしれません。でも、それは設計をより良くするためのヒントです。一歩ずつ、SolidWorks VBAという広大な海をマスターしていきましょう。応援していますよ！