タイトルが正しくないのですが、Drawのビューの参照元ファイル名と
Drawファイルのファイル名が一致しているかどうかをチェックします。
'vba Link_DrawLinkCheck ver0.0.1 using-'KCL0.0.12' by Kantoku 'Drawのビュー参照元ファイル名とDrawファイル名の一致確認 'OK - ファイル名一致 'NG - ファイル名食い違い 'Nothing - リンク無し Option Explicit Sub CATMain() 'ドキュメントのチェック If Not CanExecute("DrawingDocument") Then Exit Sub 'views Dim viws As DrawingViews Set viws = CATIA.ActiveDocument.Sheets.ActiveSheet.Views 'get Dim infos As Object Set infos = KCL.InitLst() Dim i As Long For i = 3 To viws.count infos.Add GetViewLinkInfo(viws.Item(i)) Next 'done MsgBox Join(infos.toArray(), "") End Sub 'ビューリンク情報 Private Function GetViewLinkInfo( _ ByVal vi As DrawingView) As String Dim fso As Object Set fso = KCL.GetFSO() 'viewのdoc Dim drw_doc As DrawingDocument Set drw_doc = KCL.GetParent_Of_T(vi, "DrawingDocument") Dim drw_name As String drw_name = fso.GetBaseName(drw_doc.path) 'refのdoc Dim behv As DrawingViewGenerativeBehavior Set behv = vi.GenerativeBehavior Dim ref_Doc As Document Set ref_Doc = GetBehaviorDoc(behv) Dim ref_name As String If ref_Doc Is Nothing Then ref_name = vbNullString Else ref_name = fso.GetBaseName(ref_Doc.path) End If 'info Dim info As String info = "[" & vi.name & "]-" Select Case True Case drw_name = ref_name info = info & "OK" & vbCrLf Case ref_name = vbNullString info = info & "Nothing" & vbCrLf Case Else info = info & "NG!!!" & vbCrLf & _ " path:" & ref_Doc.path & vbCrLf End Select GetViewLinkInfo = info End Function Private Function GetBehaviorDoc( _ ByVal behv As DrawingViewGenerativeBehavior) As Document On Error Resume Next Dim v As Variant Set v = behv.Document Set GetBehaviorDoc = v.Parent On Error GoTo 0 End Function
実行するとこんな感じです。
UUID違いの物を、こちらの方法で差し替えたつもりでも
変わってくれない為、手っ取り早く確認したいからです。
同一UUIDのDraw参照元ファイルを差し替える1 - C#ATIA
恐らく、ここを取得しているんじゃないかと思います。
違うかな?
念の為、こちらのプロパティ
Set v = behv.Document
"Document" じゃなくて "Product" が返ってきます。