C#ATIA

↑タイトル詐欺 主にFusion360API 偶にCATIA V5 VBA(絶賛ネタ切れ中)

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

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

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

f:id:kandennti:20181127102436p:plain
「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ですよね?
f:id:kandennti:20181127102450p:plain
ここを変更する方法が、マクロの場合は前回の方法しか恐らく無く、寸法が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ファイルを利用するか?」が難しく
変な形になりました。
ネーミングルールでキッチリしたファイル名になっていれば確かに
何とかなるような気はしていますが、機種名・リビジョン・仕様・
部品名・図番...等、多くの情報をファイル名に突っ込まれても迷う。
(でも、気持ちはわかる)