C#ATIA

↑タイトル詐欺 主にCATIA V5 の VBA(最近はPMillマクロとFusion360APIが多い)

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

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

あちらのマクロを実際に業務で使用していると、リンクを持たないビューまで
リンク付きのビューにしてしまう為、使い勝手が非常に悪かったです。

その為、リンク元を差し替えるビューをユーザーが選択できるように
変更しました。

'vba ChangeDrawLink ver0.0.2  using-'KCL0.0.12'  by Kantoku
'Drawのビューのリンクの参照元を差し替える
'Partのみ?で UUID違いOK

'ver0.0.1:完成
'ver0.0.2:ビューを指定するように変更

Option Explicit

Private Const SelectionType = "*.CATPart"

Sub CATMain()
    'ドキュメントのチェック
    If Not CanExecute("DrawingDocument") Then Exit Sub
    
    'view選択
    Dim Msg As String
    Msg = "置き換えるビューを選択してください"
    
    Dim views As Collection
    Set views = SelectViews(Msg)
    If views Is Nothing Then Exit Sub
    If views.Count < 1 Then Exit Sub
    
    'ファイル選択
    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
    
    '確認
    Msg = "以下のビュー" & vbCrLf & _
        GetViewsName(views) & _
        "を、リンクの参照元" & vbCrLf & _
        path & vbCrLf & _
        "に置き換えます。宜しいですか?"
        
    If MsgBox(Msg, vbYesNo + vbQuestion) = vbNo Then Exit Sub
    
    Dim viws As DrawingViews
    Set viws = drawDoc.Sheets.ActiveSheet.views
    
    '参照オープン
    Dim refDoc As Document
    Set refDoc = CATIA.Documents.Open(path)
    
    'すり替え
    Dim vi As DrawingView
    
    For Each vi In views
        Call ChangeLink(vi, refDoc)
    Next
    
    '参照クローズ
    Call refDoc.Close
    
    MsgBox "Done"
End Sub

'ビューの選択
Private Function SelectViews( _
    ByVal Msg As String) As Collection

    Dim sel As Variant
    Set sel = CATIA.ActiveDocument.selection

    Dim filter As Variant
    filter = Array("DrawingView")

    sel.Clear
    Select Case sel.SelectElement3(filter, Msg, True, _
        CATMultiSelTriggWhenUserValidatesSelection, False)
        Case "Cancel", "Undo", "Redo"
            Exit Function
    End Select

    Dim lst As Collection
    Set lst = New Collection

    Dim i As Long
    For i = 1 To sel.Count2
        lst.Add sel.Item(i).Value
    Next
    sel.Clear

    Set SelectViews = lst
End Function

'コレクション内のビュー名をテキスト化
Private Function GetViewsName( _
    ByVal lst As Collection) As String

    Dim ary() As String
    ReDim ary(lst.Count)
    
    Dim i As Long
    For i = 1 To lst.Count
        ary(i - 1) = lst.Item(i).Name
    Next
    
    GetViewsName = Join(ary, vbCrLf)
End Function

'すり替え&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

マクロ実行後、ビューを選択(複数選択可能です)し、続いて
リンク元となるPartファイルを指定すればOKです。
指定するPartファイルはUUIDの一致不一致を問いません。

唯一の欠点は、更新後本来寸法解析した際赤くなるべき寸法が
何食わぬ顔して(黒のまま)終了してしまう事です。
これは更新しても直りません。

対策としては、再度手動でリンク元を同じファイルで置換し更新すれば
OKなのですが手間と言えばかなり手間です。

但し、UUID違いは手動ではリンク元を置換できない為、個人的には
かなり重宝します。

そして、リンクを分断したビューでもリンクを復活させる事も可能です!
(もちろん寸法はチマチマ直す必要は有ります)