形状セットの面積を測定し基準値以下の場合は色を付けるマクロ｜CATIAマクロの作成方法

今回の記事は「マクロ案」よりいただいた内容です。
送って頂いた内容は以下のようなマクロです。

ワークベンチ: generative shape design

マクロ案: 形状セット内のサーフェスのうち、基準の面積に満たないものは
　　　　色を変える(またはhideにするとか)、選別を行う。

今回のマクロは「①形状セットの面積測定」→「②面積の判定」→「③形状セットに色付け」といった流れになります。

①の面積の測定は手動の場合、[要素を測定]コマンドを使います。
VBAでこれと同じ機能を扱うには「Measurableオブジェクト」というものを使います。今回は面積の測定のみを行いますが、角度や2オブジェクト間の距離を測ったりすることもできます。

③の色付けは「VisVisPropertySetオブジェクト」の「SetRealColorメソッド」を使います。非表示(hide)にする場合も同オブジェクトの「SetShowメソッド」を使えば対応可能です。

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

マクロの機能

今回作成したのは形状セットの面積を測定し基準値以下の場合は色を付けるマクロです。
具体的な機能は以下のとおりです。

マクロの機能まとめ・仕様ツリー第1階層の形状セットの面積を測定する
・測定したときに指定した面積より小さい場合は赤色を付ける
※形状セットに色を付けるため、その中のサーフェスに色がついていると色が反映されない
　→ [ﾌﾟﾛﾊﾟﾃｨをﾘｾｯﾄ]でサーフェスの色を消しておく必要があり

基準となる面積はコード上で指定します。基準となる面積の値が高頻度で変わる場合はInputBox関数を使えば実行毎にユーザーに指定させることができるので使用用途に合わせてサンプルコードを書き換えてみて下さい。

サンプルコード

マクロのコードは以下のとおりです。

Option Explicit
Sub CATMain()

 'ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ等の定義
    If TypeName(CATIA.ActiveDocument) <> "PartDocument" Then
       MsgBox "このマクロはPartDocument専用です。" & vbLf & _
              "CATPartに切り替えて実行してください。"
       Exit Sub
    End If
    
    Dim doc As PartDocument:        Set doc = CATIA.ActiveDocument
    Dim pt As Part:                 Set pt = doc.Part
    Dim sel:                        Set sel = doc.Selection
    Dim vps As VisPropertySet:      Set vps = sel.VisProperties
    Dim spa As Workbench:           Set spa = doc.GetWorkbench("SPAWorkbench")

    Dim hb As HybridBody
    For Each hb In pt.HybridBodies
    
        Dim ref_hb As Reference
        Set ref_hb = pt.CreateReferenceFromObject(hb)
        
        Dim m As Measurable
        Set m = spa.GetMeasurable(ref_hb)
        
        Dim hb_area As Double
        hb_area = m.Area * 1000000  '単位をmm2に変更
        
     '形状ｾｯﾄ内の総面積をｲﾐﾃﾞｨｴｲﾄｳｨﾝﾄﾞｳに表示
        Debug.Print hb.Name & "　:　" & hb_area & "mm2"
        
        
     '基準の面積(これ以下の形状ｾｯﾄの色を変更)
        Const criteria_area = 600#
        
        If hb_area < criteria_area Then
            sel.Add hb
            Call vps.SetRealColor(255, 0, 0, 0)
            sel.Clear
        End If
    
    Next hb
    
End Sub

Option Explicit

Sub CATMain()

'ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ等の定義

If TypeName(CATIA.ActiveDocument) <> "PartDocument" Then

MsgBox "このマクロはPartDocument専用です。" & vbLf & _

"CATPartに切り替えて実行してください。"

Exit Sub

End If

Dim doc As PartDocument: Set doc = CATIA.ActiveDocument

Dim pt As Part: Set pt = doc.Part

Dim sel: Set sel = doc.Selection

Dim vps As VisPropertySet: Set vps = sel.VisProperties

Dim spa As Workbench: Set spa = doc.GetWorkbench("SPAWorkbench")

Dim hb As HybridBody

For Each hb In pt.HybridBodies

Dim ref_hb As Reference

Set ref_hb = pt.CreateReferenceFromObject(hb)

Dim m As Measurable

Set m = spa.GetMeasurable(ref_hb)

Dim hb_area As Double

hb_area = m.Area * 1000000 '単位をmm2に変更

'形状ｾｯﾄ内の総面積をｲﾐﾃﾞｨｴｲﾄｳｨﾝﾄﾞｳに表示

Debug.Print hb.Name & "　:　" & hb_area & "mm2"

'基準の面積(これ以下の形状ｾｯﾄの色を変更)

Const criteria_area = 600#

If hb_area < criteria_area Then

sel.Add hb

Call vps.SetRealColor(255, 0, 0, 0)

sel.Clear

End If

Next hb

End Sub

コード解説

ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ等の定義

 'ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ等の定義
    If TypeName(CATIA.ActiveDocument) <> "PartDocument" Then
       MsgBox "このマクロはPartDocument専用です。" & vbLf & _
              "CATPartに切り替えて実行してください。"
       Exit Sub
    End If
    
    Dim doc As PartDocument:        Set doc = CATIA.ActiveDocument
    Dim pt As Part:                 Set pt = doc.Part
    Dim sel:                        Set sel = doc.Selection
    Dim vps As VisPropertySet:      Set vps = sel.VisProperties
    Dim spa As Workbench:           Set spa = doc.GetWorkbench("SPAWorkbench")

'ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ等の定義

If TypeName(CATIA.ActiveDocument) <> "PartDocument" Then

MsgBox "このマクロはPartDocument専用です。" & vbLf & _

"CATPartに切り替えて実行してください。"

Exit Sub

End If

Dim doc As PartDocument: Set doc = CATIA.ActiveDocument

Dim pt As Part: Set pt = doc.Part

Dim sel: Set sel = doc.Selection

Dim vps As VisPropertySet: Set vps = sel.VisProperties

Dim spa As Workbench: Set spa = doc.GetWorkbench("SPAWorkbench")

まずはじめにアクティブドキュメントを定義をします。
今回のマクロはCATPartのみ有効なものなので、アクティブドキュメントがCATPart以外の場合はTypeName関数を使った条件分岐でマクロを終了するようにしています。つまり、アクティブドキュメントがCATPartの場合のみ変数「doc」にアクティブドキュメントを代入し、マクロの処理を続けます。

アクティブドキュメントが定義できたら、以降で使うためのオブジェクトをまとめて定義しておきます。ここでは下記の用途で各オブジェクトを定義しています。

Partオブジェクト　　　　　：ツリー第1階層指定用
Selectionオブジェクト　　　：VisPropertySetを使用するオブジェクトの選択用
VisPropertySetオブジェクト：オブジェクト(形状ｾｯﾄ)への色付け用
SPAWorkbenchオブジェクト：寸法測定用オブジェクト呼び出し用

　
ツリー第1階層の形状セットループ

 Dim hb As HybridBody
    For Each hb In pt.HybridBodies

 '①---
        Dim ref_hb As Reference
        Set ref_hb = pt.CreateReferenceFromObject(hb)
        
        Dim m As Measurable
        Set m = spa.GetMeasurable(ref_hb)
        
        Dim hb_area As Double
        hb_area = m.Area * 1000000  '単位をmm2に変更
        
 '②---
     '形状ｾｯﾄ内の総面積をｲﾐﾃﾞｨｴｲﾄｳｨﾝﾄﾞｳに表示
        Debug.Print hb.Name & "　:　" & hb_area & "mm2"
        
 '③---       
     '基準の面積(これ以下の形状ｾｯﾄの色を変更)
        Const criteria_area = 600#
        
        If hb_area < criteria_area Then
            sel.Add hb
            Call vps.SetRealColor(255, 0, 0, 0)
            sel.Clear
        End If
    
    Next hb

Dim hb As HybridBody

For Each hb In pt.HybridBodies

'①---

Dim ref_hb As Reference

Set ref_hb = pt.CreateReferenceFromObject(hb)

Dim m As Measurable

Set m = spa.GetMeasurable(ref_hb)

Dim hb_area As Double

hb_area = m.Area * 1000000 '単位をmm2に変更

'②---

'形状ｾｯﾄ内の総面積をｲﾐﾃﾞｨｴｲﾄｳｨﾝﾄﾞｳに表示

Debug.Print hb.Name & "　:　" & hb_area & "mm2"

'③---

'基準の面積(これ以下の形状ｾｯﾄの色を変更)

Const criteria_area = 600#

If hb_area < criteria_area Then

sel.Add hb

Call vps.SetRealColor(255, 0, 0, 0)

sel.Clear

End If

Next hb

つぎにツリー第1階層の形状セットを網羅するループ処理を行います。
ループとしては「For Each hb In pt.HybridBodies」として、Partオブジェクト直下のHybridBodiesである「pt.HybridBodies」内でループを回せばOKです。

ループ内の処理としては下記の流れになっています。

① hbの面積測定(mm²)
② ①の値をｲﾐﾃﾞｨｴｲﾄｳｨﾝﾄﾞｳに表示
③ hbの面積が指定した値(上記コードの場合：600mm²)より小さい場合は赤色で色付け

　
①の面積測定は「Measurableオブジェクト」の「Areaプロパティ」を使います。
Measurableオブジェクトを定義する際に引数とした「ref_hb」が測定の対象となっています。
Arearプロパティで取得する値とCATIAの単位に誤差がある場合は、②の結果を見ながら「m.Area * 1000000」の掛ける値を調整してください。(ここではmm²になるように変換しています)

②に関してはただの実行確認です。
全ての面積がイミディエイトウィンドウに表示されます。
特に処理に関わっているわけではないので削除しても問題ありません。

③ではまず「Const criteria_area = 600#」として基準となる面積値を指定しています。
(600の後ろのシャープ[#]はDouble型であることを表しています)
あとは①で取得した値がこの基準の値より小さいかを条件分岐するだけです。

条件分岐後は「VisVisPropertySetオブジェクト」の「SetRealColorメソッド」を使って該当の形状セットに色を付けます。ここでは赤色にしていますが引数の値を変更すれば付与する色も変更することができます。