非常に個人的なPowerMillﾏｸﾛ用ﾗｲﾌﾞﾗﾘ

あまりに苦しいので、ﾗｲﾌﾞﾗﾘ的なものを作りました。
PowerMillのﾏｸﾛは、ﾏｸﾛの実行ﾌｧｲﾙ(.mac)以外に拡張子「.inc」に
することでﾗｲﾌﾞﾗﾘとして使用できるんです。(ｴﾗｲ!)

//pmill macro Kantoku_PowerMill_Library ver0.0.2
//kpl.inc
//r2017で開発

// **** ﾌｫﾙﾀﾞ ****
//指定した組み込みﾌｫﾙﾀﾞからｴﾝﾃｨﾃｨの存在するﾌｫﾙﾀﾞﾈｰﾑﾘｽﾄ取得
//param : DirName (string)
//param : Name (string)
//param : OptIsNew(bool) - 指定の名前のﾌｫﾙﾀﾞが既存にあった場合新作するか? 0_新作しない 1_新作
//param : OptIsAct(bool) - 実行後ﾌｫﾙﾀﾞをｱｸﾃｨﾌﾞにするか?  0_非ｱｸﾃｨﾌﾞ1_ｱｸﾃｨﾌﾞ
//return : Outstr(string) - 新たに出来たﾌｫﾙﾀﾞ名
function Create_Folder(string DirName , string Name , bool OptIsNew , bool OptIsAct , output string Outstr) {
	string fullname = $DirName + '\' + $Name
	string list Before = get_folders($DirName)
	
	if member($Before, $fullname) {
		if not OptIsNew {
			if OptIsAct {
				ACTIVATE FOLDER $fullname
			}
			return
		} else {
			call Get_UnOverlap_Name($fullname , $Before, $fullname)
		}
	}
	
	CREATE FOLDER $DirName ; 
	string list After = get_folders($DirName)
	string list lst= subtract($After, $Before)
	string autoname = $lst[0]
	$Outstr = basename($fullname)
	RENAME FOLDER $autoname  $Outstr
	if OptIsAct {
		ACTIVATE FOLDER $fullname
	}
}

//重複しない名前を取得
//param : Name(string) - 候補名
//param : Lst(string list) - 比較ﾘｽﾄ
//return : Outstr(string) - 重複の無い名前
function Get_UnOverlap_Name(string Name , string list Lst , output string Outstr) {
	string tmpname = $Name
	int cnt = 0
	bool fg = 0
	do {
		$fg = member($Lst, $tmpname) 
		if not $fg {
			break
		}
		$cnt = $cnt + 1
		$tmpname = $Name + '_' + String($cnt)
	} white 1
	$Outstr = $tmpname
}

// **** ｴﾝﾃｨﾃｨ ****

//指定した組み込みﾌｫﾙﾀﾞからｴﾝﾃｨﾃｨの存在するﾌｫﾙﾀﾞﾈｰﾑﾘｽﾄ取得
//param : DirName (string)
//param : Calculate(int) - 計算FG　-1以下_全て 0_未計算のみ 1以上_計算済のみ
//param : Leval (int) - ﾌｫﾙﾀﾞの階層　組み込みﾌｫﾙﾀﾞは1　指定無しは0以下
//param : RemoveLst(string list) - 除外するﾌｫﾙﾀﾞ名ﾘｽﾄ
//return : Outlst(string list)
function Get_Entitys_Dir(string Dirname , int Calculate , int Level , string list RemoveLst , output string list Outlst) {
	string list paths = {}
	call Get_Entitys_Path($Dirname , $Calculate , $Level , $paths ) 
	
	string list lst = {}
	string dirtxt = ''
	foreach itm in $paths  {
		$dirtxt = basename(dirname($itm ) ) 
		if not member($RemoveLst , $dirtxt) {
			int dmy = add_last($lst, $dirtxt)
		}
	}
	int dmy = remove_duplicates($lst)
	$Outlst = $lst
}

//指定した組み込みﾌｫﾙﾀﾞからﾍﾞｰｽﾈｰﾑﾘｽﾄ取得
//param : DirName (string)
//param : Calculate(int) - 計算FG　-1以下_全て 0_未計算のみ 1以上_計算済のみ
//param : Leval (int) - ﾌｫﾙﾀﾞの階層　組み込みﾌｫﾙﾀﾞは1　指定無しは0以下
//return : Outlst(string list)
function Get_Entitys_Base(string Dirname  , int Calculate , int Level  , output string list Outlst) {
	string list paths = {}
	call Get_Entitys_Path($Dirname , $Calculate , $Level , $paths ) 
	
	string list lst = {}
	string txt = ''
	foreach itm in $paths  {
		$txt = string(basename($itm))
		int dmy = add_last($lst, $txt )
	}
	$Outlst = $lst
}

//指定した組み込みﾌｫﾙﾀﾞからﾊﾟｽﾘｽﾄ取得
//param : DirName (string)
//param : Calculate(int) - 計算FG　-1以下_全て 0_未計算のみ 1以上_計算済のみ
//param : Leval (int) - ﾌｫﾙﾀﾞの階層　組み込みﾌｫﾙﾀﾞは1　指定無しは0以下
//return : Outlst(string list)
function Get_Entitys_Path(string Dirname , int Calculate , int Level , output string list Outlst) {
	string list ents = {}
	string ent = ''
	int cal = -1
	foreach itm in folder($Dirname)  {
		$ent = pathname($itm)
		if $Level > 0 {
			if size(tokens($ent, "\")) != $Level + 1 {
				continue
			}
		}
		if $Calculate > -1 {
			switch $itm.computed {
				case 0
					if Calculate > 0 {
						continue
					}
					break
				case 1
					if Calculate == 0 {
						continue
					}
					break
			}
		}
		int dmy = add_last($ents, $ent)
	}
	$Outlst = $ents
}

// **** その他 ****
//ﾘｽﾄから文字列
//param : Lst (string list)
//param : Delimiter (string)
//return : Outtxt(string)
function Lst_ToString(string list Lst , string Delimiter , output string Outtxt) {
	string txt = ''
	foreach itm in $Lst {
		$txt = $txt + $itm + $Delimiter
	}
	int lng = length($txt) - length($Delimiter)
	$Outtxt = substring($txt , 0 , $lng)
	return
}

//ﾀﾞﾝﾌﾟ
function Dump(string list Lst) {
	string txt = ''
	call Lst_ToString($Lst , crlf , $txt )
	print = $txt
}

//ﾀﾞｲｱﾛｸﾞ類ｵﾝ
function DialogOn() {
	DIALOGS MESSAGE ON
	DIALOGS ERROR ON
	ECHO ON DCPDEBUG TRACE COMMAND ACCEPT
}

//ﾀﾞｲｱﾛｸﾞ類ｵﾌ
function DialogOff() {
	DIALOGS MESSAGE OFF
	DIALOGS ERROR OFF
	ECHO OFF DCPDEBUG UNTRACE COMMAND ACCEPT
}

ver0.0.1 - 完成
ver0.0.2 - Get_Entitys_Dir関数に除外ﾘｽﾄ追加

ｴﾝﾃｨﾃｨの名前の重複が許されない為、先日のﾏｸﾛも何度も何度もﾘｽﾄを
取得しなくてはならない為、その辺中心に作っています。

これを利用するﾃｽﾄﾏｸﾛがこちら。

//pmill macro ｸｽﾞﾕﾆｯﾄﾃｽﾄ

function Main() {
	call DialogOff()
	
	// **** ｴﾝﾃｨﾃｨ ****
	string list lst = {}
	print = "**path**"
	call Get_Entitys_Path('Toolpath' , 1, 0, $lst ) 
	call Dump($Lst )
	call Get_Entitys_Path('Boundary' , 1 , 0 , $lst ) 
	call Dump($Lst )
	
	print = "**base**"
	call Get_Entitys_Path('Toolpath' , 1,0 , $lst ) 
	call Dump($Lst )
	call Get_Entitys_Base('Boundary' , 1 , 0 , $lst ) 
	call Dump($Lst )
	
	print = "**dir**"
	call Get_Entitys_Dir('Toolpath' , 1 , 0 , $lst ) 
	call Dump($Lst )
	call Get_Entitys_Dir('Boundary' , 1 , 2 , $lst ) 
	call Dump($Lst )
	
	//**** ﾌｫﾙﾀﾞ ****
	string Dirname = ''
	call Create_Folder('Toolpath' , 'Hoge' , 1 , 1 , $Dirname)
	print = $Dirname
	call Create_Folder('Toolpath' , 'Hoge' , 1 , 1 , $Dirname)
	print = $Dirname
	call Create_Folder('Boundary' , 'Hoge' , 1 , 1 , $Dirname)
	print = $Dirname
	call Create_Folder('Boundary' , 'Hoge' , 1 , 1 , $Dirname)
	print = $Dirname
	call Create_Folder('Tool' , 'Hoge' , 1 , 1 , $Dirname)
	print = $Dirname
	call Create_Folder('Tool' , 'Hoge' , 1 , 1 , $Dirname)
	print = $Dirname
	
	call DialogOn()
}

include kpl.inc

最後に記載した

　･･･
include kpl.inc

で読み込んでます。最初じゃなくても大丈夫なんです。(ｴﾗｲ)
(最初だとｴﾗｰﾒｯｾｰｼﾞに表示された行がずれちゃうんです)

国内だとPowerMillﾕｰｻﾞｰ少なそうだから、使う人いないだろうなぁ
(日本語のﾌｫｰﾗﾑ作って欲しい･･･)

ﾀﾞｲｱﾛｸﾞｵﾌが思った程、機能していない

上手く行かない　と思っていたらこんな記述を発見。

PowerMILL 2017 Dialogs On\Off error when run macro. - Autodesk Community

要はこんな感じでｺｰﾄﾞを書いておくと、ﾀﾞｲｱﾛｸﾞが表示されなくなります。
･･･されなくなる、はずでした。

  DIALOGS MESSAGE OFF

困っていたのは、ﾏｸﾛの処理中にﾀﾞｲｱﾛｸﾞが出てきちゃって、ﾏｸﾛ自体が止まっちゃうの
です。こっちとしては処理中に他の作業を行いたいので、まとめてﾏｸﾛで処理させたい
のに離れられなくなっちゃうんです。
10年ぐらいの前のﾊﾞｰｼﾞｮﾝのPowerMill7でも、機能していたのに･･･。

と、ｲﾛｲﾛ探しながら悩んでいたら、ﾏｸﾛの記録をとったらしっかりと記載されて
いましたw

あまりに汚いｺｰﾄﾞなので、一部のみの公開です。
ﾀﾞｲｱﾛｸﾞが出て困っていたのは、ﾂｰﾙﾊﾟｽをｱﾍﾟﾝﾄﾞ(連結)させた際に出てくる
確認用のﾀﾞｲｱﾛｸﾞです。上手く以下なかった際の処理はこんな感じ。

ｺｰﾄﾞ的には

	DIALOGS MESSAGE OFF
	foreach Itm in $AppendLst {
		//ｱﾍﾟﾝﾄﾞ処理
		EDIT TOOLPATH $CopyedName APPEND CONFIRM $Itm
	}
	DIALOGS MESSAGE ON

記録をとった上、修正したｺｰﾄﾞがこちら。

	foreach Itm in $AppendLst {
		EDIT TOOLPATH $CopyedName APPEND CONFIRM $Itm
		Yes //悩んだ末の解決策がこれだけ
	}

実際に上手く処理できるようになった動画はこちらです。

さっさと記録とれば良かった･･･。

計算済みｺｰﾅｰﾍﾟﾝｼﾙ仕上げを逆方向にする

PowerMillの機能の中でちょっとだけ不満なのが、ｺｰﾅｰﾍﾟﾝｼﾙ仕上げ加工。

大体の3DCAMｿﾌﾄには付いている機能なのですが、今まで経験した中で
唯一PowerMillだけ、下から上にﾂｰﾙﾊﾟｽを作成してくれません。
(使いたい理由は秘密)

ｻﾎﾟｰﾄさんには機能をつけて欲しいと要望を出しましたが、所詮小市民の
戯言なので、期待は出来ないと思ってます。

上から下へのﾂｰﾙﾊﾟｽを手動で方向逆転させられるので、作れなくはないの
ですが、この操作がﾒﾆｭｰの深いところにあるため非常に面倒です。

その為、ﾏｸﾛを作成しまとめて処理させる事にしました。

//pm2017 macro　sample_All_Pencil_corner_Rev.mac
//全ての計算済みコーナーペンシル仕上げ加工の方向を逆にする

function Main() {
	//ﾍﾟﾝｼﾙ検索
	STRING LIST PathLst = {}
	call GetPencilLIST($PathLst)
	
	//ﾁｪｯｸ
	STRING msg =　''
	if is_empty($PathLst) {
		$msg = '処理可能なﾍﾟﾝｼﾙﾊﾟｽがありません!!'
		message error $msg
		return
	}
	
	//ﾒｯｾｰｼﾞ
	BOOL yesno = 0
	call ListToString(PathLst, $msg)
	$msg = '以下のﾍﾟﾝｼﾙﾊﾟｽを逆方向にします。宜しいですか?' + crlf + $msg
	$yesno = QUERY $msg
	IF not yesno {
		return
	}
	
	//ﾘﾊﾞｰｽ
	STRING ActPathName = TOOLPATH.NAME
	call SetReverse(PathLst)
	
	//ｱｸﾃｨﾌﾞﾂｰﾙﾊﾟｽを実行前に戻す
	call ReActToolPath($PathLst, $ActPathName)
}

//実行前ｱｸﾃｨﾌﾞﾂｰﾙﾊﾟｽに戻す
function ReActToolPath(STRING LIST lst, STRING PathName) {
	STRING ReActName = ''
	if member($lst, $PathName) {
		call GetAfterPathName($PathName, $ReActName)
	} else {
		$ReActName = $PathName
	}
	ACTIVATE TOOLPATH $ReActName
}

//変換後のﾂｰﾙﾊﾟｽ名取得
function GetAfterPathName(STRING PathName, output STRING NewName) {
	STRING Key = '_Rev'
	STRING Before = $PathName
	INT RevPos = position($Before, $Key)
	STRING After = ''
	if $RevPos == -1 {
		$After = $Before + $Key
	} else {
		$After = replace($Before, $Key, '')		
	}
	$NewName = $After
}

//ﾊﾟｽ名修正
function RenamePath(STRING PathName) {
	STRING After = ''
	call GetAfterPathName($PathName, $After)
	RENAME Toolpath $PathName $After
}

//逆方向
function SetReverse(STRING LIST lst) {
	foreach itm in lst {
		ACTIVATE TOOLPATH $itm
		EDIT TOOLPATH REVERSE
		call RenamePath(itm)
	}
}

//計算済みﾍﾟﾝｼﾙ
function GetPencilLIST(output STRING LIST Out_lst) {
	STRING LIST lst = {}
	foreach itm in folder('Toolpath') {
		if itm.computed {
			if itm.Strategy == 'pencil_corner' {
				INT dmy = add_last(lst, itm.name)
			}
		}
	}
	INT dmy = remove_duplicates(lst)
	$Out_lst = lst
	return
}

//ﾘｽﾄの文字化
function ListToString(STRING LIST lst, output STRING Out_msg) {
	STRING msg = ""
	foreach itm in lst {
		$msg = msg + itm + crlf
	}
	$Out_msg = msg
}

ﾂﾘｰのﾂｰﾙﾊﾟｽﾌｫﾙﾀﾞ内の計算済みｺｰﾅｰﾍﾟﾝｼﾙ仕上げ加工を全て探し出し、
逆転させます。その際、ﾂｰﾙﾊﾟｽの名称を逆転させたものには、
"ﾂｰﾙﾊﾟｽ名" + "_Rev" の名称に変更し、再度実行した際は "_Rev"
の名称を削除します。
(手動でｺﾞﾁｮｺﾞﾁｮした際は、もちろんそうなりません･･･)

実際に使用した感じです。　最初に通常に作成したｼﾐｭﾚｰｼｮﾝを
実行し、ﾏｸﾛ実行後のｼﾐｭﾚｰｼｮﾝを実行してみました。

"Macro Programming Guide" に計算済みﾂｰﾙﾊﾟｽを判断するためのｻﾝﾌﾟﾙ
が記載されているのですが、ﾊﾟﾗﾒｰﾀ部分が

IF entity(‘toolpath’,Name) .Calculated {

となっているのですが、正しくは

IF entity(‘toolpath’,Name).computed {

です。　参考に出来るものが少ないだけに誤記は勘弁して欲しい。
(他にも幾つかあります)

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

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

ﾌｫﾙﾀﾞ名ﾘｽﾄを取得する

想像以上に苦しく、進まない　PowerMillﾏｸﾛです。
でも、ﾒﾝﾄﾞｸｻｲ類似作業の繰り返しはｺﾘｺﾞﾘなので、進めてます。

以前はﾒﾓ帳で作っていたのですがｗ　AutodeskのForumでこんな記述を発見。
Notepad++ Language for editing PowerMill macros. - Autodesk Community

Notepad++と言うｴﾃﾞｨﾀの、PowerMillﾏｸﾛ言語用のものがあるなんてありがたいです。
確かにﾏﾆｭｱﾙにもﾁﾗﾁﾗ出てくる名前のｴﾃﾞｨﾀなので、使おうと思ったのですが
日本語が未対応っぽい。

探すとこちらがHitしました。
Notepad++ ja-pack 1 (日本語パック) を公開してみた。 | OFF-SOFT.net

ん～よく読んでないせいか、画面が日本語になっていない･･･。 "Shift-JIS" は
使えているので、まぁこのままで行きます。

で、本題の方ですが、僕の場合Treeが長くなるのがｲﾔなので、
ﾂｰﾙﾊﾟｽや工具ﾌｫﾙﾀﾞ内にﾌｫﾙﾀﾞを作って作業してます。　こんな感じです。

面倒なんですが、ﾀﾞｯﾀﾞｰっと長いのはｲﾔなんです。　何れはﾏｸﾛやﾃﾝﾌﾟﾚｰﾄで
作るし。

後々に利用する事になりそうなので、組み込みﾌｫﾙﾀﾞ内のﾌｫﾙﾀﾞ名ﾘｽﾄを取得する
ﾏｸﾛです。

//pm2017 macro
//ﾌｫﾙﾀﾞ名取得　ｸｽﾞﾃｽﾄ

function Main() {
	STRING LIST lst = {}
	//ツールパス
	call GetFolderNameLIST('Toolpath', $lst)
	call Dump(lst)
	
	//工具
	call GetFolderNameLIST('Tool', $lst)
	call Dump(lst)
}

//指定した組み込みﾙｰﾄﾌｫﾙﾀﾞ内のﾌｫﾙﾀﾞ名を取得
function GetFolderNameLIST(STRING Lst_name, output STRING LIST Folder_lst ) {
	STRING LIST lst = {}
	foreach itm in folder(Lst_name) {
		INT dmy = add_last(lst, basename(dirname(pathname(itm))))
	}
	INT dmy = remove_duplicates(lst)
	$Folder_lst = lst
	return
}

function Dump(STRING LIST lst) {
	STRING msg = ""
	foreach itm in lst {
		$msg = msg + itm + crlf
	}
	print = msg
}

ｴｺｰｺﾏﾝﾄﾞで出力させてます。　結果はこんな感じ。

　･･･

Process Command : [\tprint = msg\n]

r2s_base
r1s_base
r05s_base

　･･･

Process Command : [\tprint = msg\n]

path
ref

　･･･

ん～　理由はわかっているのですが、空のﾌｫﾙﾀﾞ名が取得できていないです。
ﾈｽﾄしているﾌｫﾙﾀﾞ名も実は取れないんですけど、それは禁止にしよう･･･。

PowerMill 言語環境の切り替え

Space-eをﾊﾞｰｼﾞｮﾝｱｯﾌﾟしたのですが、ありがたい事にPowerMillも
ﾊﾞｰｼﾞｮﾝｱｯﾌﾟしてR2017が使えるようになりました。
(Fusion360CAMの利用を考えなくなったのはその為です)

個人的にはPowerMillは非常に優秀だと思っているのですが、
こちらの件だけは、ちょっと頂けないです。
PowerMILLのVortex - C#ATIA

出来上がる経路の優秀さはもちろんなのですが、ﾏｸﾛがかなり強力で
手動の操作の大半が出来るのではないのかな?　と思っています。

ﾏｸﾛの言語は独自ですが、CATIA同様に記録が録れるのでｽﾀｰﾄするには
十分な程の環境です。
(ﾏｸﾛだけでなく、ﾌﾟﾗｸﾞｲﾝ作成用のｻﾝﾌﾟﾙがVB・C#等でも用意されています)

DELCAM時代からﾒｰｶｰさんも、積極的に情報やﾂｰﾙを公開し、ﾒｰｶｰさんの
ﾌｫｰﾗﾑでも積極的なｱﾄﾞﾊﾞｲｽをしていた為、非常に良い印象を持って
おります。(Autodeskさんになってからも、ﾌｫｰﾗﾑは好印象です)

こちらでも楽をしたいので、ﾏｸﾛを作成したいのですが日本語環境の
ままではやりにくい部分も有り、何とか英語環境で起動したいところ。

Helpに記載が見当たらなかったので、調べてみるとこちらが
Hitしました。(ﾛｼｱ語起動)
Solved: How to change language in Powermill - Autodesk Community

理解力が乏しい為か、これはちょっと違っておりこんな感じでした。

PowerMill > lang

Enter language to use > english

大文字小文字は無関係で、一度 "lang" でEnter、"english" でEnterです。
他の言語の場合は、ｲﾝｽﾄｰﾙﾌｫﾙﾀﾞ内に言語別のﾌｫﾙﾀﾞがあったので
恐らくそのﾌｫﾙﾀﾞ名でOKのような気がしています。(未確認です)

日本語に戻す場合は

PowerMill > lang

Enter language to use > japanese

です。

・・・これもﾒﾝﾄﾞｸｻｲのでﾏｸﾛにしました。
英語へ

//pm2017 ChangeLang_Eng.mac
//英語環境へ切り替え

LANG
English

日本語へ

//pm2017 ChangeLang_JPN.mac
//日本語環境へ切り替え

LANG
Japanese

これだけなんですけどね。

CATIAと異なり、切り替えてもPowerMillの再起動は必要有りませんでした。

Drawのﾃｷｽﾄｻｲｽﾞを変更する

"Drawのﾃｷｽﾄｻｲｽﾞを変更したけど反映されない?" のような
ご相談を頂きましたが、ちょっと状況がわからないので、
現象を再現できないでいます。

ｸﾘｯｸしたﾃｷｽﾄのｻｲｽﾞを2倍にするだけのﾃｽﾄｺｰﾄﾞです。

'vba test_DrawTextSize_Double
'using-'KCL0.0.10'
'DrawTextｻｲｽﾞを2倍にする

Sub CATMain()
    'ﾄﾞｷｭﾒﾝﾄのﾁｪｯｸ
    If Not KCL.CanExecute("DrawingDocument") Then Exit Sub
    
    Dim Msg$: Msg = "テキストを選択して下さい : ESCｷｰ 終了"
    Dim Dt As DrawingText
    Dim DtSize#
    
    Do
        Set Dt = KCL.SelectItem(Msg, "DrawingText")
        If KCL.IsNothing(Dt) Then Exit Do
        DtSize = Dt.GetFontSize(0, 0) 'ｻｲｽﾞ取得
        Dt.SetFontSize 0, 0, DtSize * 2 'ｻｲｽﾞ設定
    Loop
End Sub

ｲﾛｲﾛあり、今までR2012を使用していたのでKCLがVBA7に未対応な
状態でしたので、修正しました。
他にも修正したい部分はあるのですが、時間が無く････。