PowerMill Ncﾌﾟﾛｸﾞﾗﾑ出力先の変更

PowerMillのNcﾌﾟﾛｸﾞﾗﾑ出力先のﾌｫﾙﾀﾞは、ﾃﾞﾌｫﾙﾄでは絶対ﾊﾟｽでﾌﾟﾛｼﾞｪｸﾄ内に
記録されています。正直、相対ﾊﾟｽ設定の方が使いやすいのですが････。

ﾌﾟﾘﾌｧﾚﾝｽで出力先を

{project.path}\ncprogram\{ncprogram}

としておけば、現行のﾌﾟﾛｼﾞｪｸﾄﾌｫﾙﾀﾞ内の "ncprogram" ﾌｫﾙﾀﾞに
出力されると以前サポートさんに教わりました。
新作のものは良いんですよ。

困るのは古いﾌﾟﾛｼﾞｪｸﾄを流用した場合です。
既に作成済みのNCﾌﾟﾛｸﾞﾗﾑの場合、出力先ががっちり絶対ﾊﾟｽになっており
うっかり出力すると、とんでもない所（設定された古いパス）に書き出されます。
出力先のフォルダが無い場合、エラーや警告が出るとありがたいのですが、
新たにフォルダを作成してしまい、何食わぬ顔で処理を進めてしまします。

そこで、作成済みのNCﾌﾟﾛｸﾞﾗﾑ全ての出力先を書き換えるﾏｸﾛを
（やっと）作りました。

//pm2019 macro
//NcProgram_PathChange.mac ver0.0.1
//NCパスを現行プロジェクト以下に変更
//
//-------------------------------
//ver0.0.1:完成
//-------------------------------

Function Main(){
	//toolpath
	int cnt = size(folder('ncprogram'))
	if $cnt < 1 {
		message info  'NCﾌﾟﾛｸﾞﾗﾑがありません'
	}
	
	//確認
	string list ncs =  extract(folder('ncprogram'), 'name') 
	string msg = '以下のNCﾌﾟﾛｸﾞﾗﾑ出力先を修正します' + crlf
	$msg = $msg + join($ncs,crlf) + crlf
	$msg = $msg +'宜しいですか?'
	bool yn = 0
	$yn = QUERY $msg
	if not $yn {
		return
	}
	
	//書き換え
	string ncpath = '{project.path}\ncprogram\{ncprogram}'
	foreach nc in $ncs {
		EDIT NCPROGRAM $nc FILENAME $ncpath
	}	
	
	message info  'Done'
}

実際の場面で、作った事を思い出せるかな･･･。

第二回仮予選！モデリングバトル予選大会

こちらの続きです。
第一回仮予選！モデリングバトル予選大会 - C#ATIA

先週　”毎週木曜日だと覚えておこう。”　と書いたのにすっかり忘れていました。

第二回仮予選！モデリングバトル予選大会 | ものづくりをする人を本気で応援するサイト（3DCAD・3DCAM・3Dプリンター・AI・IoT）

PM9:00にPC前に居るのは難しい。

CATIA VBAの参照設定

UserFormでD&Dを実現させるために、ListViewコントロールを
利用すると出来るようなのですが、ちょっぴり問題が･･･。

定かではないのですが、ListViewコントロールを利用する為に
参照設定でこちらの

Microsoft Windows Common Controls 5.0(SP2)
が、必要そうなのですが、特定の客先環境のCATIA VBAでは
出てくるのですが、通常インストールの環境では出てきません。
（同一PCで ﾘﾘｰｽ SP FH も同一です）

調べたからかも知れませんが、「MSComctlLib.ocx」は
ナカナカの曲者のようで･･･。

「Browse...」でムリムリ参照させてもダメっぽいんです。
かなり完成しているのに、何故？

DesignSpark Mechanical

こちらにある無料の3DCADです。
DesignSpark Mechanical

3DPDFのエクスポートが対応された際に、試すためにインストールを
したことがありました。（結果はあまり望ましくはありませんでした）

残念な事にエクスポート出来るフォーマットがSTLぐらいしかなかった
ような記憶です。

少し前に、こちらの記述を見つけました。
DesignSpark Mechanical の部品を STEP形式で書き出す
タイトルに騙されそうな（悪意は無いと思いますが…）のですが、
アーカイブ内には「.sab」フォーマットファイルが有るようです。

Fusion360では一応「.sab」フォーマットファイルのインポート
対応してますが、バージョンの問題があるかも知れません。
ShapeManager - C#ATIA

バージョン問題をクリアしているのであれば、こちらのメソッドも
「.sab」フォーマットファイル対応しているので、まとめて
インポート可能かもしれません。
Help

第一回仮予選！モデリングバトル予選大会

挑戦してみました。
fusion360.3dworks.co.jp

何となく組付けてみました。

仮予選が後3回有るので、きっと何かの形になるんじゃないでしょうか?
モデリングバトル 「FUSION BASE」予選開催！ | ものづくりをする人を本気で応援するサイト（3DCAD・3DCAM・3Dプリンター・AI・IoT）

毎週木曜日だと覚えておこう。

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

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

まだちょっと不安定な気もしているのですが、手元のデータでは
上手く行っているので公開しておきます。

先日の組合せのファイルを読み込ませ、Partファイルと同一名の
Drawingファイルを作成します。

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

'ver0.0.1:完成(ﾃｽﾄｺｰﾄﾞ)
'ver0.0.2:ﾊﾞｯﾁ処理で複数変換対応
'ver0.0.3:Update改善(LockViewによるﾏｸﾛ停止)
'         ﾀｰｹﾞｯﾄPartﾌｧｲﾙ一時的にﾊﾞｯｸｱｯﾌﾟ

Option Explicit

'***********
Private Const EXP_EXTENSION = "comb"
Private Const SelectionType = "*." & EXP_EXTENSION

Private Const BAT_CATVBS = "ReplaceDrawLinkBat.catvbs"
Private Const BAT_SCRIPT = "ReplaceDrawLink" '重要!ﾓｼﾞｭｰﾙ名
Private Const BAT_FUNCTION = "ExecReplaceLink" '重要!ﾊﾞｯﾁﾓｰﾄﾞのｴﾝﾄﾘｰﾎﾟｲﾝﾄ関数名 PrivateはNG

Private Const EVACUATION_NAME = "EVAC"
Private Const DELIMTER = "@"
Private Const DELIMTER_COMB = "|"

Private Const DEBUGMODE = False

Sub CATMain()
    
    'ﾘﾝｸ修正ﾘｽﾄﾌｧｲﾙ選択
    Dim msg As String
    msg = "Drawﾘﾝｸを修正する為のﾘｽﾄﾌｧｲﾙ(" & EXP_EXTENSION & ")を選択してください"
    
    Dim lst_path As String
    lst_path = CATIA.FileSelectionBox( _
        msg, _
        SelectionType, _
        CatFileSelectionModeOpen)
    If lst_path = vbNullString Then Exit Sub
    
    'ﾘﾝｸ修正ﾘｽﾄﾌｧｲﾙ読み込み
    Dim paths As Variant
    paths = KCL.ReadFile(lst_path)
    
    '確認
    msg = UBound(paths) + 1 & "個のﾊﾞｯﾁ処理を行います。宜しいですか?"
    If MsgBox(msg, vbYesNo + vbQuestion) = vbNo Then
        Exit Sub
    End If
    
    'catiaの実行ﾌｧｲﾙﾊﾟｽ取得
    Dim catPathtmp As Variant
    catPathtmp = Split(CATIA.SystemService.Environ("CATDLLPath"), ";")
    
    Dim catPath As String
    catPath = catPathtmp(0)
    
    '環境ﾌｧｲﾙﾊﾟｽ取得
    Dim environmentPath As Variant
    environmentPath = SplitPathName(CATIA.SystemService.Environ("CATEnvName"))
    
    'CATTempﾊﾟｽ取得
    Dim catTmp As Variant
    catTmp = CATIA.SystemService.Environ("CATTemp")
    
    'ﾊﾞｯﾁ用catvbs
    Dim macroPath As String
    macroPath = catTmp & "\" & BAT_CATVBS
    
    Dim code As String
    code = GetCatvbsCode(Join(paths, DELIMTER), macroPath)
    KCL.WriteFile macroPath, code

    'ﾊﾞｯﾁｺﾏﾝﾄﾞ
    Dim cmd As String
    cmd = catPath & "\CNEXT.exe -direnv " & _
          environmentPath(0) & " -env " & _
          environmentPath(1) & " -batch  -macro " & _
          Chr(34) & macroPath & Chr(34)

    'ﾊﾞｯﾁｽﾀｰﾄ
    Call CreateObject("Wscript.Shell").exec(cmd)
        
    MsgBox "ﾊﾞｯﾁ処理をｽﾀｰﾄしました"
End Sub


'******* ﾊﾞｯﾁ処理前 *********
'ﾊﾞｯﾁ用ｽﾌﾟﾘｸﾄｿｰｽ
Private Function GetCatvbsCode( _
    ByVal path As String, _
    ByVal me_path As String) As String
    
    'VBProjectﾊﾟｽ取得
    Dim apc As Object
    Set apc = GetApc()
    
    Dim execPjt As Object
    Set execPjt = apc.ExecutingProject
    
    Dim pjtPath As String
    pjtPath = execPjt.DisplayName
    
    Dim code As String
    code = _
        "Set SS = CATIA.SystemService" & vbCrLf & _
        "VBAProjectPath = " & Chr(34) & CStr(pjtPath) & Chr(34) & vbCrLf & _
        "LibraryType = catScriptLibraryTypeVBAProject" & vbCrLf & _
        "ScriptName = " & Chr(34) & BAT_SCRIPT & Chr(34) & vbCrLf & _
        "FunctionName = " & Chr(34) & BAT_FUNCTION & Chr(34) & vbCrLf & _
        "Dim Params(0)" & vbCrLf & _
        "Params(0) = " & Chr(34) & path & Chr(34) & vbCrLf & _
        "Call SS.ExecuteScript(VBAProjectPath, LibraryType, ScriptName, FunctionName, Params)" & vbCrLf

    If Not DEBUGMODE Then
        code = code & _
            "CreateObject(" & Chr(34) & "Scripting.FileSystemObject" & Chr(34) & ").DeleteFile(" & _
            Chr(34) & me_path & Chr(34) & ")" & vbCrLf
    End If
    
    code = code & _
        "CreateObject(" & Chr(34) & "WScript.Shell" & Chr(34) & ").Popup " & Chr(34) & "Done" & _
        Chr(34) & ", 0 , " & Chr(34) & "ReplaceDrawLink" & Chr(34) & " , 0"
    
    GetCatvbsCode = code
End Function

'ﾊﾟｽとﾌｧｲﾙ名分割
'Return: 0-Path 1-BaseName
Private Function SplitPathName(ByVal FullPath) As Variant
    Dim path(1) As String
    With CreateObject("Scripting.FileSystemObject")
        path(0) = .GetParentFolderName(FullPath)
        path(1) = .GetBaseName(FullPath)
    End With
    SplitPathName = path
End Function

'Apc取得
Private Function GetApc() As Object
    Set GetApc = Nothing
    
    'VBAﾊﾞｰｼﾞｮﾝﾁｪｯｸ
    Dim COMObjectName$
    #If VBA7 Then
        COMObjectName = "MSAPC.Apc.7.1"
    #ElseIf VBA6 Then
        COMObjectName = "MSAPC.Apc.6.2"
    #Else
        MsgBox "VBAのﾊﾞｰｼﾞｮﾝが未対応です"
        Exit Function
    #End If
    
    'APC取得
    Dim apc As Object: Set apc = Nothing
    On Error Resume Next
        Set apc = CreateObject(COMObjectName)
    On Error GoTo 0
    
    If apc Is Nothing Then
        MsgBox "MSAPC.Apcが取得できませんでした"
        Exit Function
    End If
    
    Set GetApc = apc
End Function

'******* ﾊﾞｯﾁ処理用 *********
'差し替え処理
Sub ExecReplaceLink(ByVal all_path As String)
    Dim paths As Variant
    paths = Split(all_path, DELIMTER)
    
    Dim i As Long
    Dim path As Variant
    For i = 0 To UBound(paths)
        path = Split(paths(i), DELIMTER_COMB)
        If UBound(path) < 1 Then GoTo continue
        If IsExistsFiles(path) Then
            Call ReplaceLink(path(0), path(1))
        End If
continue:
    Next
    
    If Not DEBUGMODE Then
        CATIA.Quit
    End If
End Sub

'差し替えたDrawﾌｧｲﾙ作成
Private Sub ReplaceLink( _
    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 tgtBackup As String
    tgtBackup = tgtPartPath & ".backup"
    fso.CopyFile tgtPartPath, tgtBackup
    
    '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
    Call UpdateUnlockViews(refDoc)
    
    'SaveAs
    Call SaveAs(tgtDoc, tgtPartPath)
    
    Dim tgtDraw As String
    tgtDraw = tgtPartAry(0) & "\" & _
              tgtPartAry(1) & ".CATDrawing"
    Call SaveAs(refDoc, tgtDraw)
    
    'tgtPartのﾊﾞｯｸｱｯﾌﾟ削除
    fso.DeleteFile tgtBackup
    
    'refPart戻し
    If Not refPart = vbNullString Then
        fso.MoveFile refPart, refPartAry(0) & "\"
    End If
    
    '避難先ﾌｫﾙﾀﾞ削除
    fso.DeleteFolder evac
    
    'ﾘﾈｰﾑﾌｧｲﾙ削除
    fso.DeleteFile tmpPart
    
    'ﾌｧｲﾙを閉じる
    tgtDoc.Close
    refDoc.Close
End Sub

'ﾛｯｸしていないﾘﾝｸ付きﾋﾞｭｰの更新
Private Sub UpdateUnlockViews( _
    ByVal doc As DrawingDocument)
    
    Dim sht As DrawingSheet
    Dim v As DrawingView
    For Each sht In doc.Sheets
        If sht.IsDetail Then GoTo continue_sheet
        
        For Each v In sht.Views
            If v.LockStatus Then GoTo continue_view
            If Not HasLink(v) Then GoTo continue_view
            
            v.GenerativeBehavior.Update
continue_view:
        Next
        
continue_sheet:
    Next
End Sub

'ﾘﾝｸ付きﾋﾞｭｰか?
Private Function HasLink( _
    ByVal view As DrawingView) As Boolean
    
    HasLink = False
    
    On Error Resume Next
    
    Dim behv As DrawingViewGenerativeBehavior
    Set behv = view.GenerativeBehavior
    
    Dim v As Document
    Set v = behv.Document.Parent
    
    On Error GoTo 0
    
    If v Is Nothing Then Exit Function
    
    HasLink = True
End Function

'避難ﾌｫﾙﾀﾞ
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 ary As Variant) As Boolean
    
    IsExistsFiles = False
    
    Dim i As Long
    For i = 0 To UBound(ary)
        If Not KCL.IsExists(ary(i)) Then Exit Function
    Next
    
    IsExistsFiles = True
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

最大の特徴は、ﾏｸﾛの実行はﾊﾞｯﾁﾓｰﾄﾞで起動させたCATIA側に
処理させる点です。その為、作業を行っているCATIAのｵﾍﾟﾚｰｼｮﾝは
ﾏｸﾛの起動までしか奪われません。

ｲﾛｲﾛと注意すべき点があるのですが、恐らく世間的には
「今更・・・」なﾏｸﾛだろうとは思ってます。

先日客先より支給されたDrawファイルは、リンク元の差し替えは
行われていましたが、Updateされていませんでした。
恐らく、リンク元を差し替えるマクロのようなものを持っている
のではないかな？　と勝手に思っています。

実は単純にUpdateした際、データの状態によってはダイアログが
出現しマクロが停止してしまう状況に遭遇しました。
Updateしたくなくなる気持ちもわかりますが、上記のマクロでは
対応出来ていると思います。

まだ、ちょっと機能不足なのですが、組合せリストを作る方の
マクロが異常なほど使いにくい･･･。

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" が返ってきます。