こちらの続きです。
異なる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ファイルを利用するか?」が難しく
変な形になりました。
ネーミングルールでキッチリしたファイル名になっていれば確かに
何とかなるような気はしていますが、機種名・リビジョン・仕様・
部品名・図番...等、多くの情報をファイル名に突っ込まれても迷う。
(でも、気持ちはわかる)