サーフェスに[トリムを戻す(Untrim)]を適応するマクロ｜CATIAマクロの作成方法
今回は「お問い合わせ」より頂いた内容です。
送って頂いた内容は以下のようなマクロです。
メソッドが用意されていないコマンド、例えばuntrim(GSDのコマンド)を実行したい場合、
catia.startcommand(“untrim")
CATIA.RefreshDisplay = True '続くenterを認識させる為のひと手間
SendKeys “{Enter}", Trueこのように記述すれば実行可能である事までは理解しています。
不明なのは上記の処理をfor next の繰り返し処理に入れると、
期待する結果、「複数の面のuntrimができる。」が達成されず、
「最初に選択した面のみuntrimができる。」という結果になってしまいます。
ご存知の方もいると思いますが、CATIA VBAには[トリムを戻す(Untrim)]コマンドのように、オブジェクトやメソッドなどが何も用意されていないコマンドが存在します。
このような場合の操作は上記の通り「CATIA.StartCommand」と「SendKeys」を使って"無理やり"実行させるほか手はありません。
しかしこの方法はかなり不安定で、お問い合わせいただいたような問題が出てきてしまいます。
そこで今回はこの問題を解決する方法の説明としてサンプルマクロを2つ用意しました。
不安定なことに変わりはありませんが、実行自体の確認はできたので参考にはなると思います。
マクロの機能
今回作成したマクロは『選択した形状セット内にあるサーフェスをすべてUntrimするマクロ』です。
具体的な機能は以下のとおりです。
・Untrimはツリー第1階層に新規作成される「Untrim」という形状セットに格納される
※サーフェスの形状によっては「基本形状が無限である」という"警告"が表示されます。
この警告はVBAで操作が不可なので、手動で[Enter]キー等を押下する必要があります。
ちなみに上記でいっている"警告"とは以下のようなウィンドウを指します。
このような警告文が表示されている間はマクロの処理が一時的に停止されます。
そのためVBAでこのウィンドウを閉じることはできません。
面倒ですが、これに関しては手動で処理をする必要があります。
サンプルコード①
はじめのサンプルコードは、お問い合わせで頂いた通り、For～Next内でUntrimを実行するためのコードです。
マクロ実行後、形状セットをクリックするとその中のサーフェスをすべてUntrimしていきます。
ただ、マクロの機能でも紹介してる通り、サーフェスの形状によってはUntrim時に警告ウィンドウが表示されます。このウィンドウはVBAでの操作ができないため手動でウィンドウを閉じる必要があります。ウィンドウを閉じれば処理が引き続き実行されていきます。
Sub CATMain()
If TypeName(CATIA.ActiveDocument) <> "PartDocument" Then
MsgBox "CATPart内で実行してください。"
Exit Sub
End If
Dim ws As Object
Set ws = CreateObject("Wscript.Shell")
Dim doc As PartDocument
Set doc = CATIA.ActiveDocument
Dim sel 'As Selection
Set sel = doc.Selection
sel.Clear
Dim Filter: Filter = Array("HybridBody")
Dim msg As String: msg = "形状ｾｯﾄを選択して下さい"
Dim Status As String
Status = sel.SelectElement2(Filter, msg, False)
If Status <> "Normal" Then
MsgBox "キャンセルします"
Exit Sub
End If
Dim hb As HybridBody
Set hb = sel.Item(1).Value
Dim hs As HybridShapes
Set hs = hb.HybridShapes
Dim newhb As HybridBody
Set newhb = doc.Part.HybridBodies.Add
newhb.Name = "Untrim"
Dim HSColl As Collection
Set HSColl = New Collection
Dim i As Integer
For i = 1 To hs.Count
HSColl.Add hs.Item(i)
Next i
sel.Clear
For i = 1 To HSColl.Count
DoEvents
sel.Clear
sel.Add HSColl.Item(i)
CATIA.StartCommand ("ﾄﾘﾑを戻す") '英語環境の場合は「ﾄﾘﾑを戻す」→「Untrim」に変更
CATIA.RefreshDisplay = True
ws.AppActivate "ﾄﾘﾑを戻す", (False) '英語環境の場合は「ﾄﾘﾑを戻す」→「Untrim」に変更
ws.SendKeys "{Enter}", True
Next i
End Sub
このサンプルコードの問題点は警告ウィンドウが何回も表示されてしまう点です。
実行してみるとわかりますが毎回毎回、手動でウィンドウを閉じる必要があるのでかなり面倒ですし、何よりマクロの強みを殺してしまっています。
このコードの結果を受け、次に改良版として作成したが以下のコードです。
サンプルコード②
次に紹介するコードはサンプルコード①とは違いFor～Next文を使わない方法です。
もし「ループ文で1つずつUntrimする」にこだわらない場合はこちらのコードがおすすめです。
Untrimコマンドでは複数のサーフェスを選択することで、1回の操作でまとめてUntrimすることができます。サンプルコード②はこの考えをそのままVBAで表したものです。
サンプルコード①と同じく警告ウィンドウは表示されますがUntrimの操作自体は1回なので、警告ウィンドウが表示されるのも最大で1回となります。
基本的なコード内容は全て同じですがUntrimの部分だけ少し変わっています。
Sub CATMain()
If TypeName(CATIA.ActiveDocument) <> "PartDocument" Then
MsgBox "CATPart内で実行してください。"
Exit Sub
End If
Dim ws As Object
Set ws = CreateObject("Wscript.Shell")
Dim doc As PartDocument
Set doc = CATIA.ActiveDocument
Dim sel 'As Selection
Set sel = doc.Selection
sel.Clear
Dim Filter: Filter = Array("HybridBody")
Dim msg As String: msg = "形状ｾｯﾄを選択して下さい"
Dim Status As String
Status = sel.SelectElement2(Filter, msg, False)
If Status <> "Normal" Then
MsgBox "キャンセルします"
Exit Sub
End If
Dim hb As HybridBody
Set hb = sel.Item(1).Value
Dim hs As HybridShapes
Set hs = hb.HybridShapes
Dim newhb As HybridBody
Set newhb = doc.Part.HybridBodies.Add
newhb.Name = "Untrim"
Dim i As Integer
For i = 1 To hs.Count
sel.Add hs.Item(i)
Next i
CATIA.StartCommand ("ﾄﾘﾑを戻す") '英語環境の場合は「ﾄﾘﾑを戻す」→「Untrim」に変更
CATIA.RefreshDisplay = True
ws.AppActivate "ﾄﾘﾑを戻す", (False)
ws.SendKeys "{Enter}", True
sel.Clear
End Sub
警告ウィンドウは表示されますが、サンプルコード①と比べると処理時間も早く、手動で操作する面倒も解消されました。
コード解説
ここでは「トリムを戻す(Untrim)」部分のコードを解説していきます。
「CATIA.StartCommand」と「SendKeys」での操作は、手動と全く同じようにPCに操作させているイメージです。そのため通常では裏(PC内部)で行われる処理もすべて画面に表示されるので処理時間は多少長くなってしまいます。
サンプルコード①
For i = 1 To HSColl.Count
DoEvents
sel.Clear
sel.Add HSColl.Item(i)
CATIA.StartCommand ("ﾄﾘﾑを戻す") '英語環境の場合は「ﾄﾘﾑを戻す」→「Untrim」に変更
CATIA.RefreshDisplay = True
ws.AppActivate "ﾄﾘﾑを戻す", (False) '英語環境の場合は「ﾄﾘﾑを戻す」→「Untrim」に変更
ws.SendKeys "{Enter}", True
Next i
CATIAで「CATIA.StartCommand」と「SendKeys」を使う場合は、下記コードがほぼ定型文となります。下記コードの「コマンド名」に実行したいコマンド名を入力すれば"手動と同様の操作"が行われます。(※使用言語が日本語の場合はコマンド名の半角/全角に注意)
CATIA.StartCommand (“コマンド名“) 'コマンド名のダイアログボックスを開く
CATIA.RefreshDisplay = True 'SendKeysを実行可能にする(CATIA)
ws.SendKeys “{Enter}", True '[Enter]キーを押したことにする
'※wsはWscript.Shellオブジェクト
ここで重要なのは「CATIA.StartCommand」と「SendKeys」の間に「CATIA.RefreshDisplay = True 」という処理を挟む点です。この1文を挟まないと「SendKeys」がうまく実行されないので注意しましょう。
また、上記コードではVBAではなくWscript.Shellオブジェクトから「SendKeys」を呼び出していますが、これに関してはVBA/Wscript.Shellのどちらでも問題はありません。ただ一般的にはWscript.Shellオブジェクトの「SendKeys」の方が精度が高い(安定している)といわれています。
上記の一連の流れをループ文内で行うには「DoEvents」を使います。
SendKeysは任意のキーを押したことにすることができますが、その間も処理は止まってくれません。言い換えるとキーが押される判定よりも前に処理が先へ先へと進んでしまい、予想と違う実行結果になってしまいます。
この問題を解消するためにループ文内にDoEventsを入れておく必要があります。
DoEventsを使うことで処理が終了するまでOSは制御が不能になります。
結果、しっかりとキー入力を受け取ってから処理が進むため、上記のコードがループ内でも正常に作動するようになるというわけです。
サンプルコード①としては以下の流れをループしているだけです。
手動で1つずつUntrimするのをVBAで表現しているだけの単純な流れとなっています。
1. 選択を解除
2. i 番目のサーフェスを選択
3. [ﾄﾙﾑを戻す(Untrim)]コマンド実行
4. [Enter]キーを押したことにする
サンプルコード②
Dim i As Integer
For i = 1 To hs.Count
sel.Add hs.Item(i)
Next i
CATIA.StartCommand ("ﾄﾘﾑを戻す") '英語環境の場合は「ﾄﾘﾑを戻す」→「Untrim」に変更
CATIA.RefreshDisplay = True
ws.AppActivate "ﾄﾘﾑを戻す", (False)
ws.SendKeys "{Enter}", True
sel.Clear
サンプルコード①では1つ1つを選択し、Untrimを行っていましたが、サンプルコード②では複数を選択しまとめてUntrimするという処理を行っています。
使っているコードはほとんどサンプルコード①と同じで、多少並び替えただけのものなので、どのような処理を行っているかはすぐに理解できると思います。
サンプルコード②としては以下の流れになっています。
手動で1つずつUntrimするのをVBAで表現しているだけの単純な流れとなっています。
1. サーフェスを全選択(選択した形状セット内)
2. [ﾄﾙﾑを戻す(Untrim)]コマンド実行
3. [Enter]キーを押したことにする
まとめ
今回は「サーフェスに[トリムを戻す(Untrim)]を適応するマクロ」について内容でした。
[トリムを戻す]コマンド以外にも解析系のコマンドや[分解]コマンドのようにVBA上で用意されていないものがいくつか存在します。
それららを使ったマクロを作成するには、今回にのように「CATIA.StartCommand」と「SendKeys」を使って無理やり実行させるしか方法がありません。
安定感はあまりありませんが一応実行はできるので、個人的に作業効率UPのために使うのであれば問題はないと思います。(複数の人に配って使用するのは少し危険かもしれません)
CATIAマクロを本気で勉強するなら
