読者です 読者をやめる 読者になる 読者になる

C#ATIA

↑タイトル詐欺 主にCATIA V5 の VBA

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

CATIA_V5 VBA KCL PowerMill

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

こんな感じです。
f:id:kandennti:20170210190831p:plain

悩むのが、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

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