CATIA VBAでPowerCopyのインスタンスをループ文で一括作成する方法｜CATIAマクロの作成方法

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

ワークベンチ: CATPart

マクロ案: 要素の数だけ、パワーコピーを配置する。
例)あるサーフェスの穴の数に応じて、穴径を測定するパワーコピーを配置したいです。

今回はループ文を使いPowerCopyの複数のインスタンスを一括で作成する方法を紹介していきます。
本ページのサンプルマクロはインスタンス元のドキュメントが必要なため、単純にコピペしただけでは使うことが出来ません。本マクロを使用するというよりは、ループ文を使ってPowerCopyのインスタンスを作成する方法を理解することのほうが重要です。

本ページのサンプルマクロはCATIA VBAでPowerCopyのインスタンスを作成する方法を理解している前提の内容となっています。基本的な部分はすべて定型文なので、コードを書く順番さえ抑えておけば問題ありません。

※VBAでパワーコピーを使用するには「KT1」ライセンスが必要です。

1. マクロの機能
2. VBAコード
3. コード解説
4. まとめ

マクロの機能

今回作成したのは円の直径を測定してパラメータを出力するPowerCopyのインスタンスを要素の数だけまとめて作成するマクロです。ご連絡頂いた「穴径を測定するパワーコピー」がどのようなものかわからなかったため、ここでは「円の直径＝穴径」として作成していきます。

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

マクロの機能まとめ・PowerCopyのインスタンスを要素の数だけまとめて作成する
・要素はユーザーが選択した形状セット内の「円」のみ
・ユーザーーが選択した形状セット内に「PowerCopy」というセットを作成
・複数のインスタンスは「PowerCopy_要素名」として「PowerCopy」に作成

インスタンス元ドキュメントについて(パワーコピー)

ここで使用するインスタンス元のドキュメントは上画像のようになっています。
入力オブジェクトは「円(Input_Circle)」でその穴径をパラメータとして出力します。
(ご連絡頂いたPowerCopyの中身がわからなかったので適当に作っています)
　

VBAコード

コード全体は下記の通りです。
コピペだけでは使用できないのでCATIA VBAでPowerCopyのインスタンスを作成する方法ページと下記のサンプルコードを見比べながら自身のパワーコピーにあわせて適宜コードを書き換えて下さい。

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 insf As InstanceFactory:    Set insf = pt.GetCustomerFactory("InstanceFactory")
    
 'SelectElement2で入力ｵﾌﾞｼﾞｪｸﾄの纏まった形状ｾｯﾄをﾕｰｻﾞｰ選択で取得
    Dim sel:                    Set sel = doc.Selection
    Dim filter:                 filter = Array("HybridBody")
    Dim status As String
    
    status = sel.SelectElement2(filter, "形状ｾｯﾄを選択してください", False)
    If status <> "Normal" Then Exit Sub
    
    Dim input_hb As HybridBody
    Set input_hb = sel.Item(1).Value
    sel.Clear
    
    Dim Output_hb As HybridBody
    Set Output_hb = pt.HybridBodies.Add
    Output_hb.Name = "PowerCopy"
    
 '取得した形状ｾｯﾄの中にある円ｵﾌﾞｼﾞｪｸﾄのみを取得
    Dim crcles As Collection:      Set crcles = New Collection
    Dim i As Long
    Dim hs As HybridShape
    For i = 1 To input_hb.HybridShapes.Count
        Set hs = input_hb.HybridShapes.Item(i)
        If InStr(TypeName(hs), "Circle") <> 0 Then
            crcles.Add hs
        End If
    Next i

 'ﾊﾟﾜｰｺﾋﾟｰﾄﾞｷｭﾒﾝﾄﾊﾟｽ
    Dim pc_path As String
    pc_path = "C:\Users\...\PowerCopy_HoleSize.CATPart"

 'ﾊﾟﾜｰｺﾋﾟｰ名称
    Dim pc_name As String
    pc_name = "HoleSize"
    
    With insf
    
     '①ｲﾝｽﾀﾝｽ化ﾌﾟﾛｾｽを初期化
        .EndInstanceFactory
        .BeginInstanceFactory pc_name, pc_path
        
        Dim crcle As HybridShape
        For Each crcle In crcles
           
         'input_hbを作業ｵﾌﾞｼﾞｪｸﾄにする(この中にｲﾝｽﾀﾝｽが作成される)
           pt.InWorkObject = Output_hb
           
         '②ﾘﾌｧﾚﾝｽ初期化
           .BeginInstantiate
           
         '③ﾘﾌｧﾚﾝｽの入力ｵﾌﾞｼﾞｪｸﾄを指定
           .PutInputData "Input_Circle", crcle
           
         '④ﾘﾌｧﾚﾝｽのﾊﾟﾗﾒｰﾀ値の設定(ｵﾌﾟｼｮﾝのため省略可)
         '　 ﾊﾟﾗﾒｰﾀが無いため省略
           
         '⑤ﾘﾌｧﾚﾝｽのｲﾝｽﾀﾝﾝｽを作成
           Dim inst
           Set inst = .Instantiate
           
         '⑥ﾘﾌｧﾚﾝｽのｲﾝｽﾀﾝｽ作成を終了
           .EndInstantiate
           
         'input_hbの最新形状ｾｯﾄ(＝ｲﾝｽﾀﾝｽ)の名称変更
           Output_hb.HybridBodies.Item(Output_hb.HybridBodies.Count).Name = "PowerCopy_" & crcle.Name
           
        Next crcle
        
     '⑦ｲﾝｽﾀﾝｽ化ﾌﾟﾛｾｽの終了
        .EndInstanceFactory
    
    End With
    
    pt.InWorkObject = Output_hb
    pt.Update
    
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 insf As InstanceFactory: Set insf = pt.GetCustomerFactory("InstanceFactory")

'SelectElement2で入力ｵﾌﾞｼﾞｪｸﾄの纏まった形状ｾｯﾄをﾕｰｻﾞｰ選択で取得

Dim sel: Set sel = doc.Selection

Dim filter: filter = Array("HybridBody")

Dim status As String

status = sel.SelectElement2(filter, "形状ｾｯﾄを選択してください", False)

If status <> "Normal" Then Exit Sub

Dim input_hb As HybridBody

Set input_hb = sel.Item(1).Value

sel.Clear

Dim Output_hb As HybridBody

Set Output_hb = pt.HybridBodies.Add

Output_hb.Name = "PowerCopy"

'取得した形状ｾｯﾄの中にある円ｵﾌﾞｼﾞｪｸﾄのみを取得

Dim crcles As Collection: Set crcles = New Collection

Dim i As Long

Dim hs As HybridShape

For i = 1 To input_hb.HybridShapes.Count

Set hs = input_hb.HybridShapes.Item(i)

If InStr(TypeName(hs), "Circle") <> 0 Then

crcles.Add hs

End If

Next i

'ﾊﾟﾜｰｺﾋﾟｰﾄﾞｷｭﾒﾝﾄﾊﾟｽ

Dim pc_path As String

pc_path = "C:\Users\...\PowerCopy_HoleSize.CATPart"

'ﾊﾟﾜｰｺﾋﾟｰ名称

Dim pc_name As String

pc_name = "HoleSize"

With insf

'①ｲﾝｽﾀﾝｽ化ﾌﾟﾛｾｽを初期化

.EndInstanceFactory

.BeginInstanceFactory pc_name, pc_path

Dim crcle As HybridShape

For Each crcle In crcles

'input_hbを作業ｵﾌﾞｼﾞｪｸﾄにする(この中にｲﾝｽﾀﾝｽが作成される)

pt.InWorkObject = Output_hb

'②ﾘﾌｧﾚﾝｽ初期化

.BeginInstantiate

'③ﾘﾌｧﾚﾝｽの入力ｵﾌﾞｼﾞｪｸﾄを指定

.PutInputData "Input_Circle", crcle

'④ﾘﾌｧﾚﾝｽのﾊﾟﾗﾒｰﾀ値の設定(ｵﾌﾟｼｮﾝのため省略可)

'　ﾊﾟﾗﾒｰﾀが無いため省略

'⑤ﾘﾌｧﾚﾝｽのｲﾝｽﾀﾝﾝｽを作成

Dim inst

Set inst = .Instantiate

'⑥ﾘﾌｧﾚﾝｽのｲﾝｽﾀﾝｽ作成を終了

.EndInstantiate

'input_hbの最新形状ｾｯﾄ(＝ｲﾝｽﾀﾝｽ)の名称変更

Output_hb.HybridBodies.Item(Output_hb.HybridBodies.Count).Name = "PowerCopy_" & crcle.Name

Next crcle

'⑦ｲﾝｽﾀﾝｽ化ﾌﾟﾛｾｽの終了

.EndInstanceFactory

End With

pt.InWorkObject = Output_hb

pt.Update

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 insf As InstanceFactory:    Set insf = pt.GetCustomerFactory("InstanceFactory")

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

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 insf As InstanceFactory: Set insf = pt.GetCustomerFactory("InstanceFactory")

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

アクティブドキュメントが定義できたら「Partオブジェクト」と「InstanceFactoryオブジェクト」も合わせて定義します。

　
SelectElement2で入力ｵﾌﾞｼﾞｪｸﾄのまとまった形状ｾｯﾄをﾕｰｻﾞｰ選択で取得

 'SelectElement2で入力ｵﾌﾞｼﾞｪｸﾄの纏まった形状ｾｯﾄをﾕｰｻﾞｰ選択で取得
    Dim sel:                    Set sel = doc.Selection
    Dim filter:                 filter = Array("HybridBody")
    Dim status As String
    
    status = sel.SelectElement2(filter, "形状ｾｯﾄを選択してください", False)
    If status <> "Normal" Then Exit Sub
    
    Dim input_hb As HybridBody
    Set input_hb = sel.Item(1).Value
    sel.Clear
    
    Dim Output_hb As HybridBody
    Set Output_hb = pt.HybridBodies.Add
    Output_hb.Name = "PowerCopy"

'SelectElement2で入力ｵﾌﾞｼﾞｪｸﾄの纏まった形状ｾｯﾄをﾕｰｻﾞｰ選択で取得

Dim sel: Set sel = doc.Selection

Dim filter: filter = Array("HybridBody")

Dim status As String

status = sel.SelectElement2(filter, "形状ｾｯﾄを選択してください", False)

If status <> "Normal" Then Exit Sub

Dim input_hb As HybridBody

Set input_hb = sel.Item(1).Value

sel.Clear

Dim Output_hb As HybridBody

Set Output_hb = pt.HybridBodies.Add

Output_hb.Name = "PowerCopy"

次に穴径として取得する円を取得していきます。
今回はユーザーが選択した形状セット内にある円のみを対象としています。
(さらに厳密にいうと選択した形状セット直下にある円のみ)

そこでまずはSelectionオブジェクトのSelectElement2メソッドを使ってユーザー選択により形状セットを取得し「Input_hb」とします。

また、最終出力となる形状セットを「Input_hb」内に作成します。
コード上では「Output_hb」とし、形状セット名を「PowerCopy」としています。

　
取得した形状ｾｯﾄの中にある円ｵﾌﾞｼﾞｪｸﾄのみを取得

 '取得した形状ｾｯﾄの中にある円ｵﾌﾞｼﾞｪｸﾄのみを取得
    Dim crcles As Collection:      Set crcles = New Collection
    Dim i As Long
    Dim hs As HybridShape
    For i = 1 To input_hb.HybridShapes.Count
        Set hs = input_hb.HybridShapes.Item(i)
        If InStr(TypeName(hs), "Circle") <> 0 Then
            crcles.Add hs
        End If
    Next i

'取得した形状ｾｯﾄの中にある円ｵﾌﾞｼﾞｪｸﾄのみを取得

Dim crcles As Collection: Set crcles = New Collection

Dim i As Long

Dim hs As HybridShape

For i = 1 To input_hb.HybridShapes.Count

Set hs = input_hb.HybridShapes.Item(i)

If InStr(TypeName(hs), "Circle") <> 0 Then

crcles.Add hs

End If

Next i

次に「Input_hb」内にあるオブジェクトでループし、オブジェクトタイプに「Circle」とついているものを「crcles」というコレクションに追加していきます。

これにより「crcles」コレクション内ループを行えば「Input_hb」内のすべての円に対して処理を行うことが可能になります。

　
ﾊﾟﾜｰｺﾋﾟｰﾄﾞｷｭﾒﾝﾄﾊﾟｽ / ﾊﾟﾜｰｺﾋﾟｰ名称の定義

 'ﾊﾟﾜｰｺﾋﾟｰﾄﾞｷｭﾒﾝﾄﾊﾟｽ
    Dim pc_path As String
    pc_path = "C:\Users\...\PowerCopy_HoleSize.CATPart"

 'ﾊﾟﾜｰｺﾋﾟｰ名称
    Dim pc_name As String
    pc_name = "HoleSize"

'ﾊﾟﾜｰｺﾋﾟｰﾄﾞｷｭﾒﾝﾄﾊﾟｽ

Dim pc_path As String

pc_path = "C:\Users\...\PowerCopy_HoleSize.CATPart"

'ﾊﾟﾜｰｺﾋﾟｰ名称

Dim pc_name As String

pc_name = "HoleSize"

つぎにパワーコピーを作成したインスタンス元となるドキュメントをコード上で定義していきます。
「pc_path」にはドキュメントのフルパス、「pc_name」にはパワーコピー名称を入力します。

　
ﾘﾌｧﾚﾝｽの定義とｲﾝｽﾀﾝｽの作成(ループ)

    With insf
    
     '①ｲﾝｽﾀﾝｽ化ﾌﾟﾛｾｽを初期化
        .EndInstanceFactory
        .BeginInstanceFactory pc_name, pc_path
        
        Dim crcle As HybridShape
        For Each crcle In crcles
           
         'input_hbを作業ｵﾌﾞｼﾞｪｸﾄにする(この中にｲﾝｽﾀﾝｽが作成される)
           pt.InWorkObject = Output_hb
           
         '②ﾘﾌｧﾚﾝｽ初期化
           .BeginInstantiate
           
         '③ﾘﾌｧﾚﾝｽの入力ｵﾌﾞｼﾞｪｸﾄを指定
           .PutInputData "Input_Circle", crcle
           
         '④ﾘﾌｧﾚﾝｽのﾊﾟﾗﾒｰﾀ値の設定(ｵﾌﾟｼｮﾝのため省略可)
         '　 ﾊﾟﾗﾒｰﾀが無いため省略
           
         '⑤ﾘﾌｧﾚﾝｽのｲﾝｽﾀﾝﾝｽを作成
           Dim inst
           Set inst = .Instantiate
           
         '⑥ﾘﾌｧﾚﾝｽのｲﾝｽﾀﾝｽ作成を終了
           .EndInstantiate
           
         'input_hbの最新形状ｾｯﾄ(＝ｲﾝｽﾀﾝｽ)の名称変更
           Output_hb.HybridBodies.Item(Output_hb.HybridBodies.Count).Name = "PowerCopy_" & crcle.Name
           
        Next crcle
        
     '⑦ｲﾝｽﾀﾝｽ化ﾌﾟﾛｾｽの終了
        .EndInstanceFactory
    
    End With

With insf

'①ｲﾝｽﾀﾝｽ化ﾌﾟﾛｾｽを初期化

.EndInstanceFactory

.BeginInstanceFactory pc_name, pc_path

Dim crcle As HybridShape

For Each crcle In crcles

'input_hbを作業ｵﾌﾞｼﾞｪｸﾄにする(この中にｲﾝｽﾀﾝｽが作成される)

pt.InWorkObject = Output_hb

'②ﾘﾌｧﾚﾝｽ初期化

.BeginInstantiate

'③ﾘﾌｧﾚﾝｽの入力ｵﾌﾞｼﾞｪｸﾄを指定

.PutInputData "Input_Circle", crcle

'④ﾘﾌｧﾚﾝｽのﾊﾟﾗﾒｰﾀ値の設定(ｵﾌﾟｼｮﾝのため省略可)

'　ﾊﾟﾗﾒｰﾀが無いため省略

'⑤ﾘﾌｧﾚﾝｽのｲﾝｽﾀﾝﾝｽを作成

Dim inst

Set inst = .Instantiate

'⑥ﾘﾌｧﾚﾝｽのｲﾝｽﾀﾝｽ作成を終了

.EndInstantiate

'input_hbの最新形状ｾｯﾄ(＝ｲﾝｽﾀﾝｽ)の名称変更

Output_hb.HybridBodies.Item(Output_hb.HybridBodies.Count).Name = "PowerCopy_" & crcle.Name

Next crcle

'⑦ｲﾝｽﾀﾝｽ化ﾌﾟﾛｾｽの終了

.EndInstanceFactory

End With

最後にループ文を使って要素の数だけインスタンスを作成していきます。

基本的にはCATIA VBAでPowerCopyのインスタンスを作成する方法ページで説明しているとおりの順番でInstanceFactoryオブジェクトのメソッドを実行していきます。ループ文を入れるのは下記の位置になります。

① BeginInstanceFactory
　—　ループ開始　—
② BeginInstantiate
③ PutInputData
④ GetParameter (パラメータがある場合のみ)　　　　　　　
⑤ Instantiate
⑥ EndInstantiate
　—　ループ終了　—
⑦ EndInstanceFactory

　
ループ毎に「③ PutInputData」「④ GetParameter」の引数を変えれば、入力オブジェクトやパラメータを変更させながらインスタンスを作成することができるので、ここはうまいこと調整しましょう。(ここではPutInputDataの引数をループ毎に変更しています)

また、パワーコピーは「作業オブジェクト」となっている形状セットの中に作成されます。
そこで上記コードではループ毎に「Output_hb」を作業オブジェクトに切り替え、インスタンスが常に「Output_hb」内に作成されるようにしています。

作業オブジェクトを切り替えるには下記コードを書きます。

作業オブジェクト変更

Partオブジェクト.InWorkObject = 作業オブジェクトにするObject