選択したサーフェスに面直なパイプ形状を一括作成するマクロ｜CATIAマクロの作成方法

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

ワークベンチ: part design

マクロ案:
任意の曲面に面直の複数の円柱（パイプ）形状を作るのはマクロで可能でしょうか。
＜作りたいもののイメージは丸穴のスピーカーメッシュ＞
自分の場合は曲面上の点を使って面直の直線作成
そのあとはスイープサーフェス（Φ3ｍｍ）作りました。
作業がパワーコピーでかなり楽になりましたが500個ぐらいの円柱形状の作成はちょっとしんどかった。

今回のマクロは「マクロといったらこれ」というような形状の一括作成マクロです。
コードとしてはあまり複雑ではありませんが、使い方によっては劇的に効率がUPできるので、ぜひ本ページを参考に自身の環境でも使えるようなマクロを自作してみて下さい。

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

マクロの機能

今回作成したのは選択したサーフェスに面直なパイプ形状を一括作成するマクロです。
具体的な機能は以下のとおりです。

マクロの機能まとめ・選択したサーフェスに面直なパイプ形状を一括作成する
・パイプは選択した形状セット内にある点を中心として作成される
・形状はツリー第1階層に新規作成される形状セットにまとめて作成される
・処理の流れは下記の通り
　① サーフェス選択
　② 点のまとまった形状セット選択
③ 直線作成(②の点を通り、①のサーフェスに面直な直線)
　④ スイープ作成(③を中心とするΦ3のパイプ)

スイープの直径や長さはコード上で指定しているので、任意で書き換えて下さい。

VBAコード

コード全体は下記の通りです。
マクロ実行後「①サーフェス選択→②点のまとまった形状セット選択」の順に選択してください。

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 hsf As HybridShapeFactory:  Set hsf = pt.HybridShapeFactory
    Dim sel:                        Set sel = doc.Selection
    sel.Clear
    
 '曲面(ｻｰﾌｪｽ)をﾕｰｻﾞｰ選択で取得
    Dim filter:     filter = Array("HybridShape")
    Dim res As String
    res = sel.SelectElement2(filter, "", False)
    If res <> "Normal" Then
        MsgBox "キャンセルしました。"
        Exit Sub
    End If
    
    Dim surf As HybridShape
    Set surf = sel.Item(1).Value
    sel.Clear
    
 '形状ｾｯﾄをﾕｰｻﾞｰ選択で取得
    filter = Array("HybridBody")
    res = sel.SelectElement2(filter, "", False)
    If res <> "Normal" Then
        MsgBox "キャンセルしました。"
        Exit Sub
    End If
    
    Dim input_hb As HybridBody
    Set input_hb = sel.Item(1).Value
    
 'ｽｲｰﾌﾟｻｰﾌｪｽ出力用形状ｾｯﾄ
    Dim output_hb As HybridBody
    Set output_hb = pt.HybridBodies.Add
    output_hb.Name = "パイプ"
    
 '形状ｾｯﾄ内の点をすべてｺﾚｸｼｮﾝに格納
    Dim ps As Collection
    Set ps = New Collection
    
    sel.Search ("ﾊﾟｰﾄ･ﾃﾞｻﾞｲﾝ.点 + ｼﾞｪﾈﾚｰﾃｨﾌﾞ･ｼｪｲﾌﾟ･ﾃﾞｻﾞｲﾝ.点,sel")
    
    Dim i As Long
    For i = 1 To sel.Count
        ps.Add sel.Item(i).Value
    Next i
    
 'ﾊﾟｲﾌﾟ形状作成
    Dim ref_surf As Reference
    Set ref_surf = pt.CreateReferenceFromObject(surf)
    
    Dim p 'As Point
    For Each p In ps
    
     'ﾊﾟｲﾌﾟの中心軸となる直線の作成
        Dim ref_p As Reference
        Set ref_p = pt.CreateReferenceFromObject(p)
        
        Dim l As HybridShapeLineNormal
        Set l = hsf.AddNewLineNormal(ref_surf, ref_p, 5#, -5#, False)
        
        output_hb.AppendHybridShape l
        pt.UpdateObject l
        
     'ﾊﾟｲﾌﾟ(ｽｲｰﾌﾟ)作成
        Dim ref_l As Reference
        Set ref_l = pt.CreateReferenceFromObject(l)
        
        Dim sweep As HybridShapeSweepCircle
        Set sweep = hsf.AddNewSweepCircle(ref_l)
        
        With sweep
            .Mode = 6
            .SetRadius 1, 1.5
            .SetbackValue = 0.02
'            .SmoothActivity = False
'            .GuideDeviationActivity = False
'            .FillTwistedAreas = 1
'            .C0VerticesMode = False
        End With
    
        output_hb.AppendHybridShape sweep
        pt.UpdateObject sweep
    
    Next p

 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 hsf As HybridShapeFactory: Set hsf = pt.HybridShapeFactory

Dim sel: Set sel = doc.Selection

sel.Clear

'曲面(ｻｰﾌｪｽ)をﾕｰｻﾞｰ選択で取得

Dim filter: filter = Array("HybridShape")

Dim res As String

res = sel.SelectElement2(filter, "", False)

If res <> "Normal" Then

MsgBox "キャンセルしました。"

Exit Sub

End If

Dim surf As HybridShape

Set surf = sel.Item(1).Value

sel.Clear

'形状ｾｯﾄをﾕｰｻﾞｰ選択で取得

filter = Array("HybridBody")

res = sel.SelectElement2(filter, "", False)

If res <> "Normal" Then

MsgBox "キャンセルしました。"

Exit Sub

End If

Dim input_hb As HybridBody

Set input_hb = sel.Item(1).Value

'ｽｲｰﾌﾟｻｰﾌｪｽ出力用形状ｾｯﾄ

Dim output_hb As HybridBody

Set output_hb = pt.HybridBodies.Add

output_hb.Name = "パイプ"

'形状ｾｯﾄ内の点をすべてｺﾚｸｼｮﾝに格納

Dim ps As Collection

Set ps = New Collection

sel.Search ("ﾊﾟｰﾄ･ﾃﾞｻﾞｲﾝ.点 + ｼﾞｪﾈﾚｰﾃｨﾌﾞ･ｼｪｲﾌﾟ･ﾃﾞｻﾞｲﾝ.点,sel")

Dim i As Long

For i = 1 To sel.Count

ps.Add sel.Item(i).Value

Next i

'ﾊﾟｲﾌﾟ形状作成

Dim ref_surf As Reference

Set ref_surf = pt.CreateReferenceFromObject(surf)

Dim p 'As Point

For Each p In ps

'ﾊﾟｲﾌﾟの中心軸となる直線の作成

Dim ref_p As Reference

Set ref_p = pt.CreateReferenceFromObject(p)

Dim l As HybridShapeLineNormal

Set l = hsf.AddNewLineNormal(ref_surf, ref_p, 5#, -5#, False)

output_hb.AppendHybridShape l

pt.UpdateObject l

'ﾊﾟｲﾌﾟ(ｽｲｰﾌﾟ)作成

Dim ref_l As Reference

Set ref_l = pt.CreateReferenceFromObject(l)

Dim sweep As HybridShapeSweepCircle

Set sweep = hsf.AddNewSweepCircle(ref_l)

With sweep

.Mode = 6

.SetRadius 1, 1.5

.SetbackValue = 0.02

' .SmoothActivity = False

' .GuideDeviationActivity = False

' .FillTwistedAreas = 1

' .C0VerticesMode = False

End With

output_hb.AppendHybridShape sweep

pt.UpdateObject sweep

Next p

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 hsf As HybridShapeFactory:  Set hsf = pt.HybridShapeFactory
    Dim sel:                        Set sel = doc.Selection
    sel.Clear

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

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 hsf As HybridShapeFactory: Set hsf = pt.HybridShapeFactory

Dim sel: Set sel = doc.Selection

sel.Clear

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

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

Partオブジェクト　　　　　　　　：ツリー第1階層指定用/hsf定義用
HybridShapeFactoryyオブジェクト：スイープ/直線作成用
Selectionオブジェクト ：ユーザー選択でのオブジェクト取得用

　
曲面(ｻｰﾌｪｽ)をﾕｰｻﾞｰ選択で取得

 '曲面(ｻｰﾌｪｽ)をﾕｰｻﾞｰ選択で取得
    Dim filter:     filter = Array("HybridShape")
    Dim res As String
    res = sel.SelectElement2(filter, "", False)
    If res <> "Normal" Then
        MsgBox "キャンセルしました。"
        Exit Sub
    End If
    
    Dim surf As HybridShape
    Set surf = sel.Item(1).Value
    sel.Clear

'曲面(ｻｰﾌｪｽ)をﾕｰｻﾞｰ選択で取得

Dim filter: filter = Array("HybridShape")

Dim res As String

res = sel.SelectElement2(filter, "", False)

If res <> "Normal" Then

MsgBox "キャンセルしました。"

Exit Sub

End If

Dim surf As HybridShape

Set surf = sel.Item(1).Value

sel.Clear

次にスイープを作成する際に必要になる曲面(サーフェス)を取得します。
ここではSelectionオブジェクトのSelectElement2メソッドを使って曲面を取得します。

SelectElement2のフィルターとして「HybridShape」を指定していますが、これにはサーフェスだけでなく点や曲線も含まれてしまうため、しっかりとしたフィルターにはなっていないので注意してください。(※サーフェス以外が選択されると以降でエラーが発生します)

　
形状ｾｯﾄをﾕｰｻﾞｰ選択で取得

 '形状ｾｯﾄをﾕｰｻﾞｰ選択で取得
    filter = Array("HybridBody")
    res = sel.SelectElement2(filter, "", False)
    If res <> "Normal" Then
        MsgBox "キャンセルしました。"
        Exit Sub
    End If
    
    Dim input_hb As HybridBody
    Set input_hb = sel.Item(1).Value

'形状ｾｯﾄをﾕｰｻﾞｰ選択で取得

filter = Array("HybridBody")

res = sel.SelectElement2(filter, "", False)

If res <> "Normal" Then

MsgBox "キャンセルしました。"

Exit Sub

End If

Dim input_hb As HybridBody

Set input_hb = sel.Item(1).Value

次にスイープの軸線を作成する際に必要になる点を取得します。
今回は一括で複数のパイプを作成するため、インプットとして点は複数個が想定されます。

そこでここでは点の入った形状セットをSelectionオブジェクトのSelectElement2メソッドを使って取得します。

　
ｽｲｰﾌﾟｻｰﾌｪｽ出力用形状ｾｯﾄ

 'ｽｲｰﾌﾟｻｰﾌｪｽ出力用形状ｾｯﾄ
    Dim output_hb As HybridBody
    Set output_hb = pt.HybridBodies.Add
    output_hb.Name = "パイプ"

'ｽｲｰﾌﾟｻｰﾌｪｽ出力用形状ｾｯﾄ

Dim output_hb As HybridBody

Set output_hb = pt.HybridBodies.Add

output_hb.Name = "パイプ"

つぎに新規形状セットをツリー第1階層に作成します。
これから作成する直線とスイープ形状はこの形状セット内に格納していきます。
ここではこの形状セットの名称を「パイプ」に変更しています。

　
形状ｾｯﾄ内の点をすべてｺﾚｸｼｮﾝに格納

 '形状ｾｯﾄ内の点をすべてｺﾚｸｼｮﾝに格納
    Dim ps As Collection
    Set ps = New Collection
    
    sel.Search ("ﾊﾟｰﾄ･ﾃﾞｻﾞｲﾝ.点 + ｼﾞｪﾈﾚｰﾃｨﾌﾞ･ｼｪｲﾌﾟ･ﾃﾞｻﾞｲﾝ.点,sel")
    
    Dim i As Long
    For i = 1 To sel.Count
        ps.Add sel.Item(i).Value
    Next i

'形状ｾｯﾄ内の点をすべてｺﾚｸｼｮﾝに格納

Dim ps As Collection

Set ps = New Collection

sel.Search ("ﾊﾟｰﾄ･ﾃﾞｻﾞｲﾝ.点 + ｼﾞｪﾈﾚｰﾃｨﾌﾞ･ｼｪｲﾌﾟ･ﾃﾞｻﾞｲﾝ.点,sel")

Dim i As Long

For i = 1 To sel.Count

ps.Add sel.Item(i).Value

Next i

次に先に取得していた形状セット内にある点をすべて取得します。
これにはSelectionオブジェクトのSearchメソッドを使って、psというコレクションに格納していきます。詳しくは選択しているオブジェクトを一時保管する方法を参照下さい。

これによりpsコレクション内ループを行えば、全ての点に対して処理を行うことが可能になります。(これは今回でいうところの直線/スイープの作成処理です)

　　
ﾊﾟｲﾌﾟ形状作成

 'ﾊﾟｲﾌﾟ形状作成
    Dim ref_surf As Reference
    Set ref_surf = pt.CreateReferenceFromObject(surf)
    
    Dim p 'As Point
    For Each p In ps
    
     'ﾊﾟｲﾌﾟの中心軸となる直線の作成
        Dim ref_p As Reference
        Set ref_p = pt.CreateReferenceFromObject(p)
        
        Dim l As HybridShapeLineNormal
        Set l = hsf.AddNewLineNormal(ref_surf, ref_p, 5#, -5#, False)
        
        output_hb.AppendHybridShape l
        pt.UpdateObject l
        
     'ﾊﾟｲﾌﾟ(ｽｲｰﾌﾟ)作成
        Dim ref_l As Reference
        Set ref_l = pt.CreateReferenceFromObject(l)
        
        Dim sweep As HybridShapeSweepCircle
        Set sweep = hsf.AddNewSweepCircle(ref_l)
        
        With sweep
            .Mode = 6
            .SetRadius 1, 1.5
            .SetbackValue = 0.02
'            .SmoothActivity = False
'            .GuideDeviationActivity = False
'            .FillTwistedAreas = 1
'            .C0VerticesMode = False
        End With
    
        output_hb.AppendHybridShape sweep
        pt.UpdateObject sweep
    
    Next p

'ﾊﾟｲﾌﾟ形状作成

Dim ref_surf As Reference

Set ref_surf = pt.CreateReferenceFromObject(surf)

Dim p 'As Point

For Each p In ps

'ﾊﾟｲﾌﾟの中心軸となる直線の作成

Dim ref_p As Reference

Set ref_p = pt.CreateReferenceFromObject(p)

Dim l As HybridShapeLineNormal

Set l = hsf.AddNewLineNormal(ref_surf, ref_p, 5#, -5#, False)

output_hb.AppendHybridShape l

pt.UpdateObject l

'ﾊﾟｲﾌﾟ(ｽｲｰﾌﾟ)作成

Dim ref_l As Reference

Set ref_l = pt.CreateReferenceFromObject(l)

Dim sweep As HybridShapeSweepCircle

Set sweep = hsf.AddNewSweepCircle(ref_l)

With sweep

.Mode = 6

.SetRadius 1, 1.5

.SetbackValue = 0.02

' .SmoothActivity = False

' .GuideDeviationActivity = False

' .FillTwistedAreas = 1

' .C0VerticesMode = False

End With

output_hb.AppendHybridShape sweep

pt.UpdateObject sweep

Next p

最後にこれまでに取得したオブジェクトを使いスイープを作成していきます。

形状作成の大きな流れは下記の通りです。

① 材料となる形状のオブジェクトをReferenceに変更する
② HybridShapeFactoryオブジェクトのメソッドと①のReferenceを使って形状作成　
③ 作成した形状を形状セットに追加(Append)する

　
これらをpsコレクション内ループですべての点に対して処理していきます。

今回の場合、点はループ毎に変化していきますが、曲面は常に同じものを使用します。
そのため上記コードでは予めpsコレクション内ループの外で曲面のReferenceを作っています。
(Referenceの作成はPartオブジェクトのCreateReferenceFromObjectメソッドを使います)

あとは直線を作成、その直線を使ってスイープの作成と行うだけです。
サーフェスに直交な直線の作成は「AddNewLineNormalメソッド」を使います。

直線作成

Dim l As HybridShapeLineNormal
Set l = hsf.AddNewLineNormal(ref_surf, ref_p, 5#, -5#, False)

引数は順に「直交とするサーフェス」「基準点」「始点」「終点」「向き」です。
上記コードの場合はref_pを通りref_surfに直交な、始点5ｍｍ、終点-5ｍｍの直線が作成されます。(最後のFalseをTrueにすると直線の方向が逆転して作成されます)

中心線と半径から作成されるスイープは「AddNewLineNormalメソッド」を使います。

スイープ作成

Dim sweep As HybridShapeSweepCircle
Set sweep = hsf.AddNewSweepCircle(ref_l)
With sweep
　.Mode = 6
　.SetRadius 1, 1.5
　.SetbackValue = 0.02
End With

引数は「中心線」だけです。
半径は作成後にプロパティより変更させていきます。
「sweep.Mode=6」は中心線と半径から作成するスイープを表していて
「sweep.SetRadius=1, 1.5」は半径を指定しています。(今回はΦ3なのでR1.5で指定しています)
「sweep.SetbackValue=0.02」はセットバックの値を表しています。(ここではデフォルトの2%)

サンプルコードには他のプロパティも書いてありますが、最低限上記3つさえ書いておけば問題ないので任意で追加してください。