マテリアルの名称をオブジェクト名に追記するマクロ｜CATIAマクロの作成方法

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

ワークベンチ: パートデザイン

マクロ案:
　ボディやサーフェスの名称の後ろに、割り当てられたマテリアル名を一括で追記したい。
　　”ボディ1″→”ボディ1_metal”
　　”ボディ2″→”ボディ2_wood”
　　”サーフェス1″→”サーフェス1_stone”

今回のマクロで重要なのは「マテリアルが適用されているオブジェクト」をどうやって取得するかです。マテリアルに関しては「Parent」で適用されているオブジェクトが取得できるわけではないので、少しだけ厄介ですが方法がないわけではないでそちらを紹介していきます。

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

マクロの機能

今回作成したのはマテリアルの名称をオブジェクト名に追記するマクロです。
具体的な機能は以下のとおりです。

マクロの機能まとめ・マテリアルの名称をオブジェクト名に追記するマクロ
(パラメータ「ﾏﾃﾘｱﾙ」の値をオブジェクト名に追記する)
・マテリアルが適用されている全オブジェクトが対象

サンプルコード

マクロのコードは以下のとおりです。
英語環境の場合はコードを少し書き換えないとエラーが発生するので注意してください。

Option Explicit
Sub CATMain()

 'ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ等定義
    If TypeName(CATIA.ActiveDocument) <> "PartDocument" Then
        MsgBox "CATPartに切り替えてからマクロを実行してください。"
        Exit Sub
    End If
    
    Dim doc As PartDocument:        Set doc = CATIA.ActiveDocument
    Dim pt As Part:                 Set pt = doc.Part
    Dim sel As Selection:           Set sel = doc.Selection
    Dim i As Long
    Dim j As Long
    
    
 'ﾏﾃﾘｱﾙﾊﾟﾗﾒｰﾀをすべて取得
    sel.Search ("(名前=ﾏﾃﾘｱﾙ & ﾅﾚｯｼﾞｳｪｱ.ﾊﾟﾗﾒｰﾀ),all")
    
    Dim parms As Collection
    Set parms = New Collection

    For i = 1 To sel.Count
        parms.Add sel.Item(i).Value
    Next i
    sel.Clear
    

 'ｵﾌﾞｼﾞｪとﾏﾃﾘｱﾙ名の組み合わせをすべて取得
    Dim objs As Collection:             Set objs = New Collection
    Dim material_names As Collection:   Set material_names = New Collection
    
    For i = 1 To parms.Count
    
    'ﾏﾃﾘｱﾙ取得
        Dim material_name As String
        material_name = parms.Item(i).Value
    
     'ﾏﾃﾘｱﾙが適用されているｵﾌﾞｼﾞｪを取得
        Dim obj_path As String
        obj_path = parms.Item(i).Name
        obj_path = Replace(obj_path, "\ﾏﾃﾘｱﾙ", "")
        
        Dim path
        path = Split(obj_path, "\")
        
        Dim obj
        Dim key As String
        Set obj = pt
        For j = 0 To UBound(path)
            sel.Clear
            sel.Add obj
            key = "名前=" & path(j) & ",sel"
            sel.Search (key)
            Set obj = sel.Item(1).Value
        Next j
        
     'ｵﾌﾞｼﾞｪｸﾄとﾏﾃﾘｱﾙ名をｺﾚｸｼｮﾝに格納
        objs.Add obj
        material_names.Add material_name
    
    Next i
    

 'ｵﾌﾞｼﾞｪ名にﾏﾃﾘｱﾙを追加
    For i = 1 To objs.Count
    
        Set obj = objs.Item(i)
        material_name = material_names.Item(i)
    
        obj.Name = obj.Name & "_" & material_name
    
    Next i

End Sub

Option Explicit

Sub CATMain()

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

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

MsgBox "CATPartに切り替えてからマクロを実行してください。"

Exit Sub

End If

Dim doc As PartDocument: Set doc = CATIA.ActiveDocument

Dim pt As Part: Set pt = doc.Part

Dim sel As Selection: Set sel = doc.Selection

Dim i As Long

Dim j As Long

'ﾏﾃﾘｱﾙﾊﾟﾗﾒｰﾀをすべて取得

sel.Search ("(名前=ﾏﾃﾘｱﾙ & ﾅﾚｯｼﾞｳｪｱ.ﾊﾟﾗﾒｰﾀ),all")

Dim parms As Collection

Set parms = New Collection

For i = 1 To sel.Count

parms.Add sel.Item(i).Value

Next i

sel.Clear

'ｵﾌﾞｼﾞｪとﾏﾃﾘｱﾙ名の組み合わせをすべて取得

Dim objs As Collection: Set objs = New Collection

Dim material_names As Collection: Set material_names = New Collection

For i = 1 To parms.Count

'ﾏﾃﾘｱﾙ取得

Dim material_name As String

material_name = parms.Item(i).Value

'ﾏﾃﾘｱﾙが適用されているｵﾌﾞｼﾞｪを取得

Dim obj_path As String

obj_path = parms.Item(i).Name

obj_path = Replace(obj_path, "\ﾏﾃﾘｱﾙ", "")

Dim path

path = Split(obj_path, "\")

Dim obj

Dim key As String

Set obj = pt

For j = 0 To UBound(path)

sel.Clear

sel.Add obj

key = "名前=" & path(j) & ",sel"

sel.Search (key)

Set obj = sel.Item(1).Value

Next j

'ｵﾌﾞｼﾞｪｸﾄとﾏﾃﾘｱﾙ名をｺﾚｸｼｮﾝに格納

objs.Add obj

material_names.Add material_name

Next i

'ｵﾌﾞｼﾞｪ名にﾏﾃﾘｱﾙを追加

For i = 1 To objs.Count

Set obj = objs.Item(i)

material_name = material_names.Item(i)

obj.Name = obj.Name & "_" & material_name

Next i

End Sub

コード解説

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

 'ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ等定義
    If TypeName(CATIA.ActiveDocument) <> "PartDocument" Then
        MsgBox "CATPartに切り替えてからマクロを実行してください。"
        Exit Sub
    End If
    
    Dim doc As PartDocument:        Set doc = CATIA.ActiveDocument
    Dim pt As Part:                 Set pt = doc.Part
    Dim sel As Selection:           Set sel = doc.Selection
    Dim i As Long
    Dim j As Long

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

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

MsgBox "CATPartに切り替えてからマクロを実行してください。"

Exit Sub

End If

Dim doc As PartDocument: Set doc = CATIA.ActiveDocument

Dim pt As Part: Set pt = doc.Part

Dim sel As Selection: Set sel = doc.Selection

Dim i As Long

Dim j As Long

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

アクティブドキュメントが定義できたら、「Partオブジェクト」と「Selectionオブジェクト」を定義します。また、あわせて以降のループ処理で使うカウント変数として「i」「j」も用意しておきます。
　

ﾏﾃﾘｱﾙﾊﾟﾗﾒｰﾀをすべて取得

 'ﾏﾃﾘｱﾙﾊﾟﾗﾒｰﾀをすべて取得
    sel.Search ("(名前=ﾏﾃﾘｱﾙ & ﾅﾚｯｼﾞｳｪｱ.ﾊﾟﾗﾒｰﾀ),all")
    
    Dim parms As Collection
    Set parms = New Collection

    For i = 1 To sel.Count
        parms.Add sel.Item(i).Value
    Next i
    sel.Clear

'ﾏﾃﾘｱﾙﾊﾟﾗﾒｰﾀをすべて取得

sel.Search ("(名前=ﾏﾃﾘｱﾙ & ﾅﾚｯｼﾞｳｪｱ.ﾊﾟﾗﾒｰﾀ),all")

Dim parms As Collection

Set parms = New Collection

For i = 1 To sel.Count

parms.Add sel.Item(i).Value

Next i

sel.Clear

つぎにマテリアルパラメータを取得し、「parms」というコレクションに全て格納します。
(参照：選択しているオブジェクトを一時保管する方法)

ここではドキュメント内にある「ﾏﾃﾘｱﾙ」という名称のパラメータを全て取得しにいきます。
そのためマテリアルのパラメータ以外に「ﾏﾃﾘｱﾙ」という名称のパラメータが存在しているとうまく実行できない可能性があるので注意しましょう。

ｵﾌﾞｼﾞｪとﾏﾃﾘｱﾙ名の組み合わせをすべて取得

'ｵﾌﾞｼﾞｪとﾏﾃﾘｱﾙ名の組み合わせをすべて取得
    Dim objs As Collection:             Set objs = New Collection
    Dim material_names As Collection:   Set material_names = New Collection
    
    For i = 1 To parms.Count
    
    'ﾏﾃﾘｱﾙ取得
        Dim material_name As String
        material_name = parms.Item(i).Value
    
     'ﾏﾃﾘｱﾙが適用されているｵﾌﾞｼﾞｪを取得
        Dim obj_path As String
        obj_path = parms.Item(i).Name
        obj_path = Replace(obj_path, "\ﾏﾃﾘｱﾙ", "")
        
        Dim path
        path = Split(obj_path, "\")
        
        Dim obj
        Dim key As String
        Set obj = pt
        For j = 0 To UBound(path)
            sel.Clear
            sel.Add obj
            key = "名前=" & path(j) & ",sel"
            sel.Search (key)
            Set obj = sel.Item(1).Value
        Next j
        
     'ｵﾌﾞｼﾞｪｸﾄとﾏﾃﾘｱﾙ名をｺﾚｸｼｮﾝに格納
        objs.Add obj
        material_names.Add material_name
    
    Next i

'ｵﾌﾞｼﾞｪとﾏﾃﾘｱﾙ名の組み合わせをすべて取得

Dim objs As Collection: Set objs = New Collection

Dim material_names As Collection: Set material_names = New Collection

For i = 1 To parms.Count

'ﾏﾃﾘｱﾙ取得

Dim material_name As String

material_name = parms.Item(i).Value

'ﾏﾃﾘｱﾙが適用されているｵﾌﾞｼﾞｪを取得

Dim obj_path As String

obj_path = parms.Item(i).Name

obj_path = Replace(obj_path, "\ﾏﾃﾘｱﾙ", "")

Dim path

path = Split(obj_path, "\")

Dim obj

Dim key As String

Set obj = pt

For j = 0 To UBound(path)

sel.Clear

sel.Add obj

key = "名前=" & path(j) & ",sel"

sel.Search (key)

Set obj = sel.Item(1).Value

Next j

'ｵﾌﾞｼﾞｪｸﾄとﾏﾃﾘｱﾙ名をｺﾚｸｼｮﾝに格納

objs.Add obj

material_names.Add material_name

Next i

つぎに前項で取得した「parms」をもとに、それぞれのパラメータに対する「マテリアルが適用されているオブジェクト」と「マテリアルの名称」を取得しにいきます。「マテリアルが適用されているオブジェクト」は「objs」、「マテリアルの名称」は「material_names」に格納していきます。

マテリアルが適用されているオブジェクトは、パラメータの名前から取得していきます。
パラメータの名前はVBAで取得すると「Part1¥ﾊﾟｰﾂﾎﾞﾃﾞｨｰ¥ﾏﾃﾘｱﾙ」のように取得されます。

本コードでは、このパラメータの名前を「￥」で分割(Split)して、仕様ツリーの上から順に名称検索をかけてオブジェクトを取得しています。(※この部分は処理に時間がかかるため、もう少しいい方法があるかもしれません。)

例えば「Part1¥ﾊﾟｰﾂﾎﾞﾃﾞｨｰ¥ﾏﾃﾘｱﾙ」の場合は「ﾊﾟｰﾂﾎﾞﾃﾞｨｰ」にマテリアルが適用されているということがわかるので、「Part1」の中の「ﾊﾟｰﾂﾎﾞﾃﾞｨｰ」というように上から順にマテリアルが適用されているオブジェクトを取得しにいっています。

ｵﾌﾞｼﾞｪ名にﾏﾃﾘｱﾙを追加

 'ｵﾌﾞｼﾞｪ名にﾏﾃﾘｱﾙを追加
    For i = 1 To objs.Count
    
        Set obj = objs.Item(i)
        material_name = material_names.Item(i)
    
        obj.Name = obj.Name & "_" & material_name
    
    Next i

'ｵﾌﾞｼﾞｪ名にﾏﾃﾘｱﾙを追加

For i = 1 To objs.Count

Set obj = objs.Item(i)

material_name = material_names.Item(i)

obj.Name = obj.Name & "_" & material_name

Next i

最後にオブジェクト名にマテリアル名称を追加していきます。
これまでの処理から、名称を変更するオブジェクトは「objs」、追加するマテリアルの名称は「material_names」に格納されています。

これらのコレクション内でループをすれば、対象オブジェクトの名称を変更することができます。

まとめ

今回はマテリアルの名称をオブジェクト名に追記するマクロについての内容でした。

今回のマクロで重要なポイントは「マテリアルが適用されているオブジェクトの取得方法」と「マテリアル名称の取得方法」の2点です。

「マテリアルが適用されているオブジェクトの取得方法」はパラメータの名称(ex. Part1¥ﾊﾟｰﾂﾎﾞﾃﾞｨｰ¥ﾏﾃﾘｱﾙ)から取得することができ、「マテリアル名称の取得方法」は単純に「マテリアルパラメータ.Value」で取得することができます。この2点が取得できればあとは名称を変更するだけです。
　

サンプルマクロ集に戻る
 目次へ戻る