PowerMillに同位置の作業平面を作る

加工する際、世の中の方々は加工原点をどうやって決めているんでしょうか?
部品の原点が決まっているようであれば、そこを原点にするのかも知れない
のですが、基準まで加工して作る場合は･･･ﾊﾞｲｽを使用していたら材料の
上側の左奥(か、右奥･･･わかりにくいですね)になるのだろうと思いますが、
社内で使用している治具の関係で、うちの場合は材料底面の中心部分にする
と言う、暗黙なﾙｰﾙが見え隠れしています。

こんな感じです。

悩むのが、CADの原点と加工原点が違う際にどうするのか?
世間の皆様はどうしているのでしょう???
恐らくCAM側で加工原点を作成して作業をするのだろうと思うのですが、
個人的にPowerMillの作業平面(加工原点)の操作が、思ったより
やりにくい･･･(うちが材料の中心部にしているせいです)

なので、今まではCATIAで座標変換させてIgesｴｸｽﾎﾟｰﾄさせていたのですが、
後々に確認したい場合に結構不便で困っていました。

PowerMillのﾏｸﾛは独自言語なのですが、外部からﾏｸﾛの実行が出来ます。
VBAでも出来ちゃうので、CATIAの座標系情報を元にPowerMillの作業平面を
作成してしまおう!　と思いつき、ﾏｸﾛを作ってみました。

'vba sample_PM_Push_AxisSystem Ver0.0.1
'using-'KCL0.0.10' 'PowerMill'
Option Explicit

Sub CATMain()
    'ﾄﾞｷｭﾒﾝﾄのﾁｪｯｸ
    If Not CanExecute("PartDocument") Then Exit Sub
    
    'ﾊﾟﾜｰﾐﾙ取得
    Dim Pm As Object: Set Pm = GetPowerMill()
    If KCL.IsNothing(Pm) Then
        MsgBox "ﾊﾟﾜｰﾐﾙを起動して下さい!"
        Exit Sub
    End If
    
    'ｴｸｽﾎﾟｰﾄする座標系選択
    Dim Axis As AxisSystem
    Set Axis = KCL.SelectItem("座標系を選択して下さい", "AxisSystem")
    If KCL.IsNothing(Axis) Then Exit Sub

    '座標系ﾃﾞｰﾀ取得
    Dim AxisCoord As Variant: AxisCoord = GetAxisCoord(Axis)
    
    'ﾊﾟﾜｰﾐﾙ　作業平面作成
    Call CreateWorkPlane_Pm(Pm, AxisCoord)
End Sub


' *** Catia ***
'座標系ﾃﾞｰﾀ取得
Private Function GetAxisCoord(ByVal Axis As AxisSystem) As Variant
    Dim Ax: Set Ax = Axis
    Dim Ori(2), VecX(2), VecY(2)
    Call Ax.GetOrigin(Ori)
    Call Ax.GetVectors(VecX, VecY)
    
    GetAxisCoord = Array(Axis.Name, _
                         Ori(0), Ori(1), Ori(2), _
                         VecX(0), VecX(1), VecX(2), _
                         VecY(0), VecY(1), VecY(2))
End Function


'*** PowerMill ***
'ﾊﾟﾜｰﾐﾙ取得
Private Function GetPowerMill() As Object
    On Error Resume Next
        Set GetPowerMill = GetObject(, "PMILL.Document")
    On Error GoTo 0
End Function

'ﾀﾞｲｱﾛｸﾞ類ｵﾝ
Private Sub DialogOn_Pm(ByVal Pm As Object)
    With Pm
        Call .Docommand("DIALOGS MESSAGE ON")
        Call .Docommand("DIALOGS ERROR ON")
        Call .Docommand("ECHO ON DCPDEBUG TRACE COMMAND ACCEPT")
    End With
End Sub

'ﾀﾞｲｱﾛｸﾞ類ｵﾌ
Private Sub DialogOff_Pm(ByVal Pm As Object)
    With Pm
        Call .Docommand("DIALOGS MESSAGE OFF")
        Call .Docommand("DIALOGS ERROR OFF")
        Call .Docommand("ECHO OFF DCPDEBUG UNTRACE COMMAND ACCEPT")
    End With
End Sub

'ﾊﾟﾜｰﾐﾙに作業平面作成
Private Sub CreateWorkPlane_Pm(ByVal Pm As Object, ByVal Axcoord As Variant)
    Call DialogOff_Pm(Pm)
    
    With Pm
        '新ｴﾝﾃｨﾃｨ名
        Call .Execute("string NewName = new_entity_name('Workplane')", 1)
        
        '作業平面作成・編集開始
        Call .Execute("CREATE WORKPLANE ; EDITOR", 1)
        Call .Execute("ACTIVATE WORKPLANE $NewName", 1)
        Call .Execute("MODE WORKPLANE_EDIT START $NewName", 1)
        
        'ﾘﾈｰﾑ
        Dim ReName$: ReName$ = Get_NewWPName_Pm(Pm, Axcoord(0))
        If Not ReName$ = vbNullString Then
            Call .Execute("MODE WORKPLANE_EDIT NAME """ & ReName & """ ", 1)
        End If
    
        '原点
        Call .Execute("MODE WORKPLANE_EDIT POSITION", 1)
        Call .Execute("MODE POSITION WORKSPACE WORLD", 1)
        Call .Execute("MODE POSITION PLANE XY", 1)
        Call .Execute("MODE POSITION CARTESIAN X """ & CStr(Axcoord(1)) & """ ", 1)
        Call .Execute("MODE POSITION CARTESIAN Y """ & CStr(Axcoord(2)) & """ ", 1)
        Call .Execute("MODE POSITION CARTESIAN Z """ & CStr(Axcoord(3)) & """ ", 1)
        Call .Execute("POSITION APPLY", 1)
        
        'X軸
        Call .Execute("MODE WORKPLANE_EDIT DIRECTION X", 1)
        Call .Execute("MODE DIRECTION WORKSPACE WORLD", 1)
        Call .Execute("MODE DIRECTION COMPONENT I """ & CStr(Axcoord(4)) & """ ", 1)
        Call .Execute("MODE DIRECTION COMPONENT J """ & CStr(Axcoord(5)) & """ ", 1)
        Call .Execute("MODE DIRECTION COMPONENT K """ & CStr(Axcoord(6)) & """ ", 1)
        Call .Execute("DIRECTION ACCEPT", 1)
        
        'Y軸
        Call .Execute("MODE WORKPLANE_EDIT DIRECTION Y", 1)
        Call .Execute("MODE DIRECTION WORKSPACE WORLD", 1)
        Call .Execute("MODE DIRECTION COMPONENT I """ & CStr(Axcoord(7)) & """ ", 1)
        Call .Execute("MODE DIRECTION COMPONENT J """ & CStr(Axcoord(8)) & """ ", 1)
        Call .Execute("MODE DIRECTION COMPONENT K """ & CStr(Axcoord(9)) & """ ", 1)
        Call .Execute("DIRECTION ACCEPT", 1)
        
        '編集終了
        Call .Execute("MODE WORKPLANE_EDIT FINISH ACCEPT", 1)
    End With
    
    Call DialogOn_Pm(Pm)
End Sub

'重複を避けた作業平面名を取得
Private Function Get_NewWPName_Pm(ByVal Pm As Object, ByVal Name As String) As String
    Get_NewWPName_Pm = Name
    
    If Name = vbNullString Then Exit Function
    
    Dim Ret, CallBackMsg$
    With Pm
        Call .Docommand("STRING LIST $lst={}")
        Ret = .Execute("$lst = extract(folder('Workplane'), 'name')", 1)
        Ret = .ExecuteEx("PRINT PAR '$lst'", 0, CallBackMsg)
    End With
    
    Dim WPNameDic As Object: Set WPNameDic = Get_WPNameList_Pm(CallBackMsg)
    If WPNameDic.Count < 1 Then Exit Function
    
    Dim TmpName$: TmpName = Name
    Dim Count&: Count = 0
    Do
        If Not WPNameDic.Exists(TmpName) Then Exit Do
        Count = Count + 1
        TmpName = Name & "_" & CStr(Count)
    Loop
    
    Get_NewWPName_Pm = TmpName
End Function

'ﾊﾟﾜｰﾐﾙの作業平面名辞書
Private Function Get_WPNameList_Pm(ByVal Txt As String) As Object
    Set Get_WPNameList_Pm = Nothing
    Const Key = "(STRING) "
    Dim KeyLng: KeyLng = Len(Key)
    
    Dim Ary: Ary = Split(Txt, vbNewLine)
    Dim Dic As Object: Set Dic = KCL.InitDic()
    
    Dim i&, KeyIdx&
    For i = 0 To UBound(Ary)
        KeyIdx = InStr(Ary(i), Key)
        If KeyIdx > 0 Then
            Call Dic.Add(Mid(Ary(i), KeyIdx + KeyLng), 1)
        End If
    Next
    
    Set Get_WPNameList_Pm = Dic
End Function

CreateWorkPlane_Pm関数が、ﾋﾞｯｸﾘするぐらい酷い状況･･･。
結果的に、GetObjectでPowerMillを所得しﾏｸﾛのｺｰﾄﾞを垂れ流しです。

実際に試してみた動画がこちら
(予め、CADﾃﾞｰﾀはｲﾝﾎﾟｰﾄしてあります)

作業平面を作る過程を止める事も出来るようですが、動画に箔がつくのでそのままです。
本当は、作成した作業平面をｱｸﾃｨﾌﾞにしたかったのですが･･･上手く行ってません。
それでも便利です。　悩みが一個解消しました。

忘れちゃいそうなので、覚書としてのｺｰﾄﾞ的な部分です。

外部からの操作で、関数の戻り値が取得できるものかどうか疑問でしたが、
ﾌｫｰﾗﾑの記載を参考にしました。　作業平面名の重複を避けるため作業平面ﾌｫﾙﾀﾞ
から全作業平面名を取得する必要が有りました。
Get_NewWPName_Pm・Get_WPNameList_Pm関数でその辺の処理をしています。

こちらのｺｰﾄﾞはｴｺｰｺﾏﾝﾄﾞの表示を止めるもののようで、
中にはこの表示を止めないとﾏｸﾛが上手く動作しないものがあるようです。
(よくわかっていないのですが、ｴﾗｰがらみだと思います)

ECHO OFF DCPDEBUG UNTRACE COMMAND ACCEPT

ところが逆のｴｺｰｺﾏﾝﾄﾞに表示させる為のｺｰﾄﾞが、探しても探しても
見つかりませんでした。　何となく感で打ち込んだところ
こちらで再表示させられるようになりました。

ECHO ON DCPDEBUG TRACE COMMAND ACCEPT

ひょっとしたら何処かに記載されているかも。