加工する際、世の中の方々は加工原点をどうやって決めているんでしょうか?
部品の原点が決まっているようであれば、そこを原点にするのかも知れない
のですが、基準まで加工して作る場合は･･･ﾊﾞｲｽを使用していたら材料の
上側の左奥(か、右奥･･･わかりにくいですね)になるのだろうと思いますが、
社内で使用している治具の関係で、うちの場合は材料底面の中心部分にする
と言う、暗黙なﾙｰﾙが見え隠れしています。
こんな感じです。
悩むのが、CADの原点と加工原点が違う際にどうするのか?
世間の皆様はどうしているのでしょう???
恐らくCAM側で加工原点を作成して作業をするのだろうと思うのですが、
個人的にPowerMillの作業平面(加工原点)の操作が、思ったより
やりにくい･･･(うちが材料の中心部にしているせいです)
なので、今まではCATIAで座標変換させてIgesｴｸｽﾎﾟｰﾄさせていたのですが、
後々に確認したい場合に結構不便で困っていました。
PowerMillのﾏｸﾛは独自言語なのですが、外部からﾏｸﾛの実行が出来ます。
VBAでも出来ちゃうので、CATIAの座標系情報を元に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
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
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)
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)
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
ひょっとしたら何処かに記載されているかも。
