Drawﾋﾞｭｰのリンク元ﾌｧｲﾙ名のチェック

タイトルが正しくないのですが、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" が返ってきます。

同一UUIDのDraw参照元ファイルを差し替える3

こちらの続きです。
同一UUIDのDraw参照元ファイルを差し替える2 - C#ATIA

レーベンシュタイン距離を利用して二つのフォルダ内のファイル郡を
類似したファイル名同士の組み合わせリストを作ります。
（日本語がおかしいかも）

'vba CreateReplaceComb ver0.0.1  using-'KCL0.0.12'  by Kantoku
'ReplaceDrawLink用の組合せﾘｽﾄ作成

Option Explicit

'**API***
Private Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
        (ByVal pidl As LongPtr, ByVal pszPath As String) As Boolean
        
Private Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" _
    (lpBrowseInfo As BROWSEINFO) As LongPtr
Private Type BROWSEINFO
    hOwner As LongPtr
    pidlRoot As LongPtr
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As LongPtr
    lParam As LongPtr
    iImage As Long
End Type

Private Declare PtrSafe Function GetDesktopWindow Lib "USER32" () As LongPtr
'***********

Private Const DELIMTER_COMB = "|"
Private Const EXP_EXTENSION = "comb"
Private Const SELECTIONTYPE = "*." & EXP_EXTENSION

Private Const PART_EXTENSION = "CATPart"
Private Const DRAW_EXTENSION = "CATDrawing"

Private Const MIN_RATIO = 10

Sub CATMain()
    Dim msg As String
    
    'Part側
    msg = "参照元となるPartが入ったﾌｫﾙﾀﾞを指定してください"
    Dim pt_path As String
    pt_path = SelectFolder(msg)
    If pt_path = vbNullString Then Exit Sub
    
    'Draw側
    msg = "参考のDrawが入ったﾌｫﾙﾀﾞを指定してください"
    Dim dw_path As String
    dw_path = SelectFolder(msg)
    If dw_path = vbNullString Then Exit Sub
    
    '確認
    msg = "参照元 : " & pt_path & vbCrLf & _
        "参　考 : " & dw_path & vbCrLf & _
        "を元に組合せﾌｧｲﾙを作成します" & vbCrLf & _
        "宜しいですか?"
    If MsgBox(msg, vbYesNo + vbQuestion) = vbNo Then Exit Sub
    
    'Part側
    Dim pt_dic As Object
    Set pt_dic = GetFilesDic(pt_path, PART_EXTENSION)
    If pt_dic.Count < 1 Then
        MsgBox "拡張子 [ " & PART_EXTENSION & " ] のﾌｧｲﾙが見つかりませんでした"
        Exit Sub
    End If
    
    'Draw側
    Dim dw_dic As Object
    Set dw_dic = GetFilesDic(dw_path, DRAW_EXTENSION)
    If dw_dic.Count < 1 Then
        MsgBox "拡張子 [ " & DRAW_EXTENSION & " ] のﾌｧｲﾙが見つかりませんでした"
        Exit Sub
    End If
    
    '組合せ
    Dim comb As Object
    Set comb = GetCombin(pt_dic, dw_dic)
    If comb.Count < 1 Then
        MsgBox "ファイル名の類似した組合せが見つかりませんでした"
        Exit Sub
    End If
    
    'ｴｸｽﾎﾟｰﾄ
    Dim exp_path As String
    exp_path = GetExportFilePath("組合せ保存")
    If exp_path = vbNullString Then Exit Sub
    
    Call KCL.WriteFile(exp_path, Join(comb.toArray(), vbCrLf))
    
    '表示
    Call shell("notepad.exe " & exp_path, vbNormalFocus)
    
End Sub

'ｴｸｽﾎﾟｰﾄﾌｧｲﾙﾊﾟｽ
Private Function GetExportFilePath( _
    ByVal msg As String)
    
    GetExportFilePath = vbNullString
    
    Dim fso As Object
    Set fso = KCL.GetFSO
    
    Dim exp_path As String
    Dim msg2 As String
    Do
        exp_path = CATIA.FileSelectionBox( _
            msg, _
            SELECTIONTYPE, _
            CatFileSelectionModeSave)
        If exp_path = vbNullString Then Exit Function
        
        If fso.GetExtensionName(exp_path) = "" Then
            exp_path = exp_path & "." & EXP_EXTENSION
        End If
        
        If KCL.IsExists(exp_path) Then
            msg2 = "[" & fso.GetFile(exp_path).Name & "]" & vbCrLf & _
                "は存在します。上書きしますか?"
            If MsgBox(msg2, vbYesNo + vbQuestion) = vbYes Then
                Exit Do
            End If
        Else
            Exit Do
        End If
    Loop
    
    GetExportFilePath = exp_path
End Function

'組み合わせ
'MIN_RATIO以下は相手無しとする
Private Function GetCombin( _
    ByVal pt_dic As Object, _
    ByVal dw_dic As Object)
    
    Dim comb As Object
    Set comb = KCL.InitLst()
    
    Dim p As Variant, d As Variant, stock As String
    Dim ratio As Long, max_ra As Long
    For Each p In pt_dic.keys
        max_ra = 0
        stock = ""
        For Each d In dw_dic
            ratio = Levenshtein(p, d)
            If max_ra < ratio Then
                max_ra = ratio
                stock = d
            End If
        Next
        If ratio > MIN_RATIO Then
            comb.Add pt_dic(p) & DELIMTER_COMB & dw_dic(stock)
        Else
            comb.Add pt_dic(p) & DELIMTER_COMB & ""
        End If
    Next
    Set GetCombin = comb
End Function

'指定ﾌｫﾙﾀﾞﾊﾟｽ内の指定拡張子ﾌｧｲﾙ辞書
Private Function GetFilesDic( _
    ByVal path As String, _
    Optional ByVal ext = "") As Object
    
    Dim fso As Object
    Set fso = KCL.GetFSO
    
    Dim dic As Object
    Set dic = KCL.InitDic
    
    Dim f As Object
    For Each f In fso.GetFolder(path).files
        If Len(ext) < 1 Then
            dic.Add fso.GetBaseName(f), f
        ElseIf LCase(ext) = LCase(fso.GetExtensionName(f)) Then
            dic.Add fso.GetBaseName(f), f
        End If
    Next
    Set GetFilesDic = dic
End Function

'ﾌｫﾙﾀﾞ選択
Private Function SelectFolder( _
    Optional msg As String) As String
    
    Dim bInfo As BROWSEINFO
    bInfo.pidlRoot = 0&
    If IsMissing(msg) Then
        bInfo.lpszTitle = "フォルダの選択..."
    Else
        bInfo.lpszTitle = msg
    End If
    bInfo.ulFlags = &H1
    
    Dim X As LongPtr
    X = SHBrowseForFolder(bInfo)
    
    Dim pPath As String
    pPath = Space$(512)
    
    Dim R As Boolean
    R = SHGetPathFromIDList(ByVal X, ByVal pPath)
    
    Dim pos As Integer
    If R Then
        pos = InStr(pPath, Chr$(0))
        SelectFolder = Left(pPath, pos - 1)
    Else
        SelectFolder = vbNullString
    End If
End Function

CATPartの入ったフォルダとCATDrawingの入ったフォルダを指定し、
リンク元を差し替える為の組合せをリスト化したファイルを作ります。
（この表現でもわかりにくい）
このマクロ自体は通過点です。内容的にはCATIAとは無関係なのですが、
Excelでの利用とか全く考えてません。

最初はCSVファイルを作成するつもりだったのですが、CSVの一般的な
区切り文字「，」がファイル名として許されます。
今の所「，」を使われたファイル名が手元に無いのですが、将来的に
”ファイル名に使われない”　と言う保障が無い為（と、言うより
利用される気がしてならない）ファイル名として許されない文字を
区切り文字としてみました。
･･･今時だったらJSONが良いのかなぁ

同一UUIDのDraw参照元ファイルを差し替える2

こちらの続きです。
同一UUIDのDraw参照元ファイルを差し替える1 - C#ATIA

前回の最後に「指定したPartﾌｧｲﾙから、どのDrawﾌｧｲﾙを利用するか？」が
難しくと書きました。　難しいです。
一発で差し替えは個人的にほぼムリと考えています。

・組み合わせる為の暫定的なリストを、CSVファイルで作成（マクロ）
　↓
・Excelでチョロチョロ調整（人力）
　↓
・差し替えDrawの作成（マクロ）

の2本立てを考えてます。

どうやって、暫定的な組合せを作ろうか？　と思い真っ先に思いついたのが
こちらです。

レーベンシュタイン距離に触れてみる - Infomentのブログ

Infomentさん感謝してます。正直、レーベンシュタイン距離なんて知りませんでした。
リンク先のリンク先のコードを元に、テストの為のコードを作ったのですが、
文字数の制約やExcel限定っぽさがあったので少し変更しました。

'vba using-'KCL0.0.12'  by Kantoku
Sub Test_LevenshteinDistance()
    Dim path1 As String
    path1 = "C:\Program Files\Dassault Systemes\B22\win_b64\code\bin32"
    
    Dim fs1 As Object
    Set fs1 = GetFiles(path1)
    
    Dim path2 As String
    path2 = "C:\Program Files\Dassault Systemes\B27\win_b64\code\bin32"
    
    Dim fs2 As Object
    Set fs2 = GetFiles(path2)
    
    Dim dic As Object
    Set dic = KCL.InitDic()
    
    Dim v1, v2, ratio, max_ra, stack
    For Each v1 In fs1
        max_ra = 0
        stack = ""
        For Each v2 In fs2
            ratio = Levenshtein(v1, v2)
            If max_ra < ratio Then
                max_ra = ratio
                stack = v2
            End If
        Next
        Debug.Print max_ra & "% : " & v1 & " <-> " & stack
    Next
End Sub

Private Function GetFiles(ByVal path As String)
    Dim fso As Object
    Set fso = KCL.GetFSO
    
    Dim lst As Object
    Set lst = KCL.InitLst()
    
    Dim f As Object
    For Each f In fso.GetFolder(path).files
        lst.Add f.Name
    Next
    Set GetFiles = lst
End Function

'https://infoment.hatenablog.com/entry/2018/11/17/183339
'https://code.i-harness.com/ja/q/40be5c
Private Function Levenshtein( _
    ByVal str1 As String, _
    ByVal str2 As String) As Long
    
    Dim str1_len As Long
    str1_len = Len(str1)
    
    Dim str2_len As Long
    str2_len = Len(str2)
    
    Dim dist() As Long
    ReDim dist(str1_len, str2_len)
    dist(0, 0) = 0
    
    Dim smStr1() As Long
    ReDim smStr1(str1_len) As Long
    Dim i As Long
    For i = 1 To str1_len
        dist(i, 0) = i
        smStr1(i) = Asc(LCase(Mid$(str1, i, 1)))
    Next
    
    Dim smStr2() As Long
    ReDim smStr2(str2_len) As Long
    For i = 1 To str2_len
        dist(0, i) = i
        smStr2(i) = Asc(LCase(Mid$(str2, i, 1)))
    Next
    
    Dim min1 As Long, min2 As Long, min3 As Long, minmin As Long, MaxL As Long
    Dim j As Long
    For i = 1 To str1_len
        For j = 1 To str2_len
            If smStr1(i) = smStr2(j) Then
                dist(i, j) = dist(i - 1, j - 1)
            Else
                min1 = dist(i - 1, j) + 1
                min2 = dist(i, j - 1) + 1
                min3 = dist(i - 1, j - 1) + 1
                If min2 < min1 Then
                    If min2 < min3 Then minmin = min2 Else minmin = min3
                Else
                    If min1 < min3 Then minmin = min1 Else minmin = min3
                End If
                dist(i, j) = minmin
            End If
        Next
    Next
    
    MaxL = str1_len
    If str2_len > MaxL Then MaxL = str2_len
    
    Levenshtein = 100 - CLng((dist(str1_len, str2_len) * 100) / MaxL)
End Function

あまり業務っぽいファイル名だとまずいので、同一のCATIAのインストールフォルダの
一部をR22とR27で比較しています。結果はこちら

100% : CATAutoItf.dll <-> CATAutoItf.dll
100% : CATJNIBridge.dll <-> CATJNIBridge.dll
100% : CATRTCChildProcess.exe <-> CATRTCChildProcess.exe
100% : CATRTCDlg.dll <-> CATRTCDlg.dll
100% : CATRTCItf.dll <-> CATRTCItf.dll
100% : CATRTCMsgLayer.dll <-> CATRTCMsgLayer.dll
100% : CATRTCMSLiveImpl.dll <-> CATRTCMSLiveImpl.dll
100% : CATRTCSametimeImpl.dll <-> CATRTCSametimeImpl.dll
100% : CATSysAllocator.dll <-> CATSysAllocator.dll
66% : CATSysAllocator.dll.beforeSPK <-> CATSysAllocator.dll
100% : CATSysMainThreadMQ.dll <-> CATSysMainThreadMQ.dll
69% : CATSysMainThreadMQ.dll.beforeSPK <-> CATSysMainThreadMQ.dll
100% : CATSysMultiThreading.dll <-> CATSysMultiThreading.dll
71% : CATSysMultiThreading.dll.beforeSPK <-> CATSysMultiThreading.dll
100% : CATSysPreview.dll <-> CATSysPreview.dll
100% : CATSysTS.dll <-> CATSysTS.dll
55% : CATSysTS.dll.beforeSPK <-> CATSysTS.dll
100% : CATSysTSObjectModeler.dll <-> CATSysTSObjectModeler.dll
71% : CATSysTSObjectModeler.dll.beforeSPK <-> CATSysTSObjectModeler.dll
100% : CATVBAHostingApplication.exe <-> CATVBAHostingApplication.exe
100% : CATVBAInfra.dll <-> CATVBAInfra.dll
100% : JS0FM.dll <-> JS0FM.dll
47% : JS0FM.dll.beforeSPK <-> JS0FM.dll
100% : JS0GROUP.dll <-> JS0GROUP.dll
55% : JS0GROUP.dll.beforeSPK <-> JS0GROUP.dll
100% : JS0SPEXT.dll <-> JS0SPEXT.dll
55% : JS0SPEXT.dll.beforeSPK <-> JS0SPEXT.dll
100% : mfc70u.dll <-> mfc70u.dll
100% : msvci70.dll <-> msvci70.dll
100% : msvcr70.dll <-> msvcr70.dll

「～win_b64\code\bin」の様に、ファイル数が多いフォルダで試すと
処理が返って来ませんでした･･･。
恐らく毎回動的配列を確保しているからじゃないかな？

「AI採用してます」って嘘ついても大丈夫そうなぐらいな結果が
得られている気がします。

同一UUIDのDraw参照元ファイルを差し替える1

こちらの続きです。
異なるUUIDのDraw参照元ファイルを差し替える2 - C#ATIA

前回のものはUUID違いでも扱えるものの、形状と寸法とのリンクが切れてしまう為
ｲﾏｲﾁです。UUIDが一致している場合は、やはりドイツ語で書かれた手法で
やりたい所です。

「C:\temp\A」ﾌｫﾙﾀﾞにはベースとなるファイルがあり、"A_Block.CATDrawing" は
"A_Block.CATPart" とリンクした状態です。

「C:\temp\B」ﾌｫﾙﾀﾞには　"B_Block.CATPart" が有りこれはUUIDが
"A_Block.CATPart" と一致しているファイルです。　これを元に "B_Block.CATDrawing"
を作成します。要は "プロジェクトA" を元に派生品の "プロジェクトB" を進めていて、
3Dだけ進めた後に図面を作りたい　と言うｲﾒｰｼﾞです。

恐らく世間の皆様にとっては今更だろうと思うのですが、自分にとっては手探りに
近いので念のためおさらいです。

手動で行うのであれば、「編集」-「リンク...」でリンク元を変更すればOKですよね？

ここを変更する方法が、マクロの場合は前回の方法しか恐らく無く、寸法がNGです。
これを回避するのが、ドイツ語で書かれたファイル名を変更しながらの方法です。
以前は「Unofficial CATIA User Forum」にも記載はあったのですが、現在は
恐らく日本語のWeb上では手順が記載されていないと思います。
上記のファイルの状態での手順だと

1."A_Block.CATPart" のファイル名を変更する（又は別のﾌｫﾙﾀﾞに移動）
2."B_Block.CATPart" を "A_Block.CATPart" にファイル名を変更する
3.ファイル名を変更した "A_Block.CATPart" を開く
4."A_Block.CATDrawing" を開く
5."A_Block.CATDrawing" を更新する
6.それぞれを "B_Block.CATPart" "B_Block.CATDrawing" として保存する
7.「1」のﾌｧｲﾙを元に戻す
8.「2」でﾘﾈｰﾑした "A_Block.CATPart" を削除

「1」を行うことでDrawをリンク切れ状態にし、開いている同一名の
Partファイルでリンクさせているようです。試した所Drawはリンク元を
A）開いているファイル
B）リンク元のファイル
の順に探しているようです。
（設定次第かも知れません。・・・ちょっと怖いなこれ）

これをマクロで行います。
・UUIDは一致
・CATDrawingとCATPartのファイル名は一致
　（そのようなネームングルールの企業は多いはずです）
・ビューはロックしていない状態
他にもファイル名が重複しない等、細かな制約があるのですが
まだテスト段階なのでご勘弁を。

'vba ReplaceDrawLink ver0.0.1  using-'KCL0.0.12'  by Kantoku
'ﾍﾞｰｽとなるﾌｧｲﾙ名はCATPartとCATDrawingで一致している事が前提
'UUIDが一致している事前提です（違うと置換されないです）

Option Explicit

Private Const EVACUATION_NAME = "EVAC"

Sub CATMain()
    Dim path_set As String
    path_set = "C:\temp\B\B_Block.CATPart,C:\temp\A\A_Block.CATDrawing"
    
    If IsExistsFiles(path_set) Then
        Dim path As Variant
        path = Split(path_set, ",")
        Call ExecReplaceLink(path(0), path(1))
    End If
    
    MsgBox "Done"
End Sub

'差し替えたDrawﾌｧｲﾙ作成
Private Sub ExecReplaceLink( _
    ByVal tgtPartPath As String, _
    ByVal refDrawPath As String)
    
    '避難先ﾌｫﾙﾀﾞ
    Dim evac As String
    evac = GetEvacuationPath(refDrawPath)
    
    'refPartの避難
    Dim refPartAry As Variant
    refPartAry = KCL.SplitPathName(refDrawPath)
    refPartAry(2) = "CATPart"
    
    Dim refPart As String
    refPart = refPartAry(0) & "\" & _
              refPartAry(1) & "." & _
              refPartAry(2)
    
    Dim fso As Object
    Set fso = KCL.GetFSO()
    
    If KCL.IsExists(refPart) Then
        fso.MoveFile refPart, evac & "\"
        refPart = evac & "\" & _
                  refPartAry(1) & "." & _
                  refPartAry(2)
    Else
        refPart = vbNullString
    End If
    
    'tgtPartのﾘﾈｰﾑ
    Dim tgtPartAry As Variant
    tgtPartAry = KCL.SplitPathName(tgtPartPath)
    
    Dim tmpPart As String
    tmpPart = refPartAry(1) & "." & _
              tgtPartAry(2)
    fso.GetFile(tgtPartPath).Name = tmpPart
    tmpPart = tgtPartAry(0) & "\" & _
              tmpPart

    'tgt(tmp)Partのｵｰﾌﾟﾝ
    Dim tgtDoc As PartDocument
    Set tgtDoc = CATIA.Documents.Open(tmpPart)
    
    'refDrawのｵｰﾌﾟﾝ
    Dim refDoc As DrawingDocument
    Set refDoc = CATIA.Documents.Open(refDrawPath)
    
    'refDrawのUpdate
    refDoc.Update
    
    'SaveAs
    Call SaveAs(tgtDoc, tgtPartPath)
    
    Dim tgtDraw As String
    tgtDraw = tgtPartAry(0) & "\" & _
              tgtPartAry(1) & ".CATDrawing"
    Call SaveAs(refDoc, tgtDraw)
    
    'refPart戻し
    If Not refPart = vbNullString Then
        fso.MoveFile refPart, refPartAry(0) & "\"
    End If
    
    '避難先ﾌｫﾙﾀﾞ削除
    fso.DeleteFolder evac
    
    'ﾘﾈｰﾑﾌｧｲﾙ削除
    fso.DeleteFile tmpPart
End Sub

'避難ﾌｫﾙﾀﾞ
Private Function GetEvacuationPath( _
    ByVal path As String) As String
    
    Dim evac As String
    evac = KCL.GetFSO.getParentFolderName(path) & "\" & _
           EVACUATION_NAME
    
    evac = GetNewFolderName(evac)
    GetEvacuationPath = evac
    
    KCL.GetFSO.CreateFolder evac
End Function

'重複しないﾌｫﾙﾀﾞ名
Private Function GetNewFolderName$(ByVal oldPath$)
    Dim newPath As String
    newPath = oldPath
    
    If Not KCL.IsExists(newPath) Then
        GetNewFolderName = newPath
        Exit Function
    End If
    Dim TempName$, I&: I = 0
    Do
        I = I + 1
        TempName = newPath + "_" + CStr(I)
        If Not KCL.IsExists(TempName) Then
            GetNewFolderName = TempName
            Exit Function
        End If
    Loop
End Function

'複数ﾌｧｲﾙ有無ﾁｪｯｸ
Private Function IsExistsFiles( _
    ByVal paths As String) As Boolean
    
    Dim path As Variant
    path = Split(paths, ",")
    
    IsExistsFiles = KCL.IsExists(path(0)) And _
                    KCL.IsExists(path(1))
End Function

'ﾀﾞｲｱﾛｸﾞをﾌﾞﾛｯｸしたSaveAs
Private Sub SaveAs( _
    ByVal Doc As Document, _
    ByVal path As String)

    CATIA.DisplayFileAlerts = False
    Doc.SaveAs path
    CATIA.DisplayFileAlerts = True
End Sub

「指定したPartﾌｧｲﾙから、どのDrawﾌｧｲﾙを利用するか？」が難しく
変な形になりました。
ネーミングルールでキッチリしたファイル名になっていれば確かに
何とかなるような気はしていますが、機種名・リビジョン・仕様・
部品名・図番...等、多くの情報をファイル名に突っ込まれても迷う。
（でも、気持ちはわかる）

異なるUUIDのDraw参照元ファイルを差し替える2

こちらの続きです。
異なるUUIDのDraw参照元ファイルを差し替える1 - C#ATIA

コメント部分のリンク先のコードを参考に
・ファイルの選択化
・全てのﾋﾞｭｰのﾘﾝｸ参照元対応

'vba ChangeDrawLink ver0.0.1  using-'KCL0.0.12'  by Kantoku
'Drawのﾋﾞｭｰのﾘﾝｸの参照元を差し替える
'Partのみで　UUID違いOK

Option Explicit

Private Const SelectionType = "*.CATPart"

Sub CATMain()
    'ﾄﾞｷｭﾒﾝﾄのﾁｪｯｸ
    If Not CanExecute("DrawingDocument") Then Exit Sub
    
    'ﾌｧｲﾙ選択
    Dim Msg As String
    Msg = "Drawで参照するﾌｧｲﾙを選択してください"
    
    Dim path As String
    path = CATIA.FileSelectionBox( _
        Msg, _
        SelectionType, _
        CatFileSelectionModeOpen)
    If path = vbNullString Then Exit Sub
    
    'Draw
    Dim drawDoc As DrawingDocument
    Set drawDoc = CATIA.ActiveDocument
    
    Dim viws As DrawingViews
    Set viws = drawDoc.sheets.ActiveSheet.Views
    
    '参照ｵｰﾌﾟﾝ
    Dim refDoc As Document
    Set refDoc = CATIA.Documents.Open(path)
    
    'すり替え
    Dim i As Long
    For i = 2 To viws.Count
        Call ChangeLink(viws.Item(i), refDoc)
    Next
    
    '参照ｸﾛｰｽﾞ
    Call refDoc.Close
    
    MsgBox "Done"
End Sub

'すり替え&Update
Private Sub ChangeLink( _
    ByVal viw As DrawingView, _
    ByVal doc As Document)
    
    Dim links As DrawingViewGenerativeLinks
    Set links = viw.GenerativeLinks
    links.RemoveAllLinks
    
    Dim behv As DrawingViewGenerativeBehavior
    Set behv = viw.GenerativeBehavior
    
    behv.Document = doc
    behv.Update
End Sub

実際にUUID違いのPartで差し替えてみました。

元の状態無いとわかりづらいですね。
確かに差し替えられるのですが、メインビュー（Views.Item(1)）に出来上がる
これは何？　何か間違えているかなぁ？
あと、寸法解析しているのにも関わらず、寸法が赤くなってくれない時が
偶にあるのが困る。（寸法を少し動かすと赤くなりました）

これだけじゃ面白くない。バッチモードでドバーっとやりたい。

任意のビューのみを強制更新

「任意のビューのみを強制更新させる
　drawingview.GenerativeBehavior.ForceUpdate()の括弧の中身は何でしょう?」
と御質問頂きました。
括弧の中身は不要で、空の括弧でOKです　と思ったのですが、
サンプルを作成してみると、括弧自体が消えてしまいます。

'vba Draw_ForceUpdate ver0.0.1  using-'KCL0.0.12'  by Kantoku

Option Explicit

Sub CATMain()
    'ﾄﾞｷｭﾒﾝﾄのﾁｪｯｸ
    If Not CanExecute("DrawingDocument") Then Exit Sub
    
    Dim msg As String
    msg = "強制更新するビューを選択 : ESC/ｷｬﾝｾﾙ"
    Dim vi As DrawingView
    
    Do
        Set vi = KCL.SelectItem(msg, "DrawingView")
        If vi Is Nothing Then Exit Sub
        
        If vi.LockStatus Then
            MsgBox "ﾛｯｸされているため強制更新出来ません!", vbExclamation
        Else
            call vi.GenerativeBehavior.ForceUpdate '括弧が消える
        End If
    Loop
    
End Sub

call の有無に問わず、無くても大丈夫みたいです。

UI Automation

こんな方法あるんですね。
Graph Tree Reordering in VBA | Scripts4All
Assyのﾘｵｰﾀﾞｰに感心しているのではなくて、この
”アクセシビリティフレームワーク”　とやらです。
UI Automationって知りませんでした。基本的にUIの単体テスト向けの
もののようにも感じるのですが･･･。

CATIAのVBAに直接書くのではなく、他のVBA（MS Officeとか･･･
実質他に選択肢無いよね？）から操作しなきゃならない　
っぽい事が記載されていますが、どうでしょう？

コード見てもWinAPIでゴリゴリやるよりはマシ　と言う感じはします、確かに。
そんなに変わらないかも知れないけど。

時間出来たら試そう。