サーフェスに[トリムを戻す(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つ用意しました。

不安定なことに変わりはありませんが、実行自体の確認はできたので参考にはなると思います。

1. マクロの機能
2. サンプルコード①
3. サンプルコード②
4. コード解説
5. まとめ

マクロの機能

今回作成したマクロは『選択した形状セット内にあるサーフェスをすべてUntrimするマクロ』です。

具体的な機能は以下のとおりです。

マクロの機能まとめ・選択した形状セット内のサーフェスをすべて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

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

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

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 と 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