CATProduct内にある任意の形状を一括で削除するマクロ｜CATIAマクロの作成方法

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

ワークベンチ:
　CATProduct

マクロ案:
　サーフェス以外を選択し削除する。
　すなわち、作図に使った直線、点、曲線、円を一括で削除したい。

今回マクロで行う処理は直線他店を削除するという「CATPart」での処理です。
これをアクティブドキュメントが「CATProduct」の状態で行うには、Product内にあるCATPartをすべて取得する必要があります。CATProductのマクロはProductとPartの関係が少し難しいですが、今回のマクロが理解できればある程度のイメージが付くと思います。

Contents

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

マクロの機能

今回作成したのはCATProduct内にある任意の形状を一括で削除するマクロです。
今回のマクロではお問い合わせ頂いた4種類のオブジェクトしか削除しませんが、コードを少し書き換えれば任意のオブジェクトをまとめて削除することが可能になります。

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

マクロの機能まとめ・CATProduct構成要素のCATPart内にある「直線」「点」「曲線」「円」をすべて削除する
・※履歴で繋がっている場合にエラーが発生する場合あり(リンクが切れていること前提)

オブジェクト削除後、形状セットが空になってもセットを削除する機能はないので、任意でコードに追加してみて下さい。

サンプルコード

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

Option Explicit
Sub CATMain()

 'ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ等定義
    Dim doc As ProductDocument:    Set doc = CATIA.ActiveDocument
    Dim rootpro As Product:        Set rootpro = doc.Product
    Dim sel As Selection:          Set sel = doc.Selection
    
 'Productをすべて設計ﾓｰﾄﾞに変更
    Call rootpro.ApplyWorkMode(DESIGN_MODE)
    
 'CATPart(Product)をすべて取得
    sel.Search ("ﾌﾟﾛﾀﾞｸﾄ･ｽﾄﾗｸﾁｬｰ.ﾊﾟｰﾂ,all")

    Dim pros As Collection:        Set pros = New Collection
    Dim pro As Product
    
    Dim i As Long
    For i = 1 To sel.Count
        pros.Add sel.Item(i).Value
    Next i

 '取得したCATPart(Product)をﾙｰﾌﾟ処理
    For Each pro In pros
    
        Dim partdoc As PartDocument:    Set partdoc = pro.ReferenceProduct.Parent
        Dim pt As Part:                 Set pt = partdoc.Part
        Dim objs As Collection:         Set objs = New Collection

     '直線取得
        sel.Clear
        sel.Add pt
        sel.Search ("ｼﾞｪﾈﾚｰﾃｨﾌﾞ･ｼｪｲﾌﾟ･ﾃﾞｻﾞｲﾝ.直線,sel")
        If sel.Count <> 0 Then
            For i = 1 To sel.Count
                objs.Add sel.Item(i).Value
            Next i
        End If
        
     '点取得
        sel.Clear
        sel.Add pt
        sel.Search ("ｼﾞｪﾈﾚｰﾃｨﾌﾞ･ｼｪｲﾌﾟ･ﾃﾞｻﾞｲﾝ.点,sel")
        If sel.Count <> 0 Then
            For i = 1 To sel.Count
                objs.Add sel.Item(i).Value
            Next i
        End If
        
     '曲線取得
        sel.Clear
        sel.Add pt
        sel.Search ("ｼﾞｪﾈﾚｰﾃｨﾌﾞ･ｼｪｲﾌﾟ･ﾃﾞｻﾞｲﾝ.曲線,sel")
        If sel.Count <> 0 Then
            For i = 1 To sel.Count
                objs.Add sel.Item(i).Value
            Next i
        End If
        
     '円取得
        sel.Clear
        sel.Add pt
        sel.Search ("ｼﾞｪﾈﾚｰﾃｨﾌﾞ･ｼｪｲﾌﾟ･ﾃﾞｻﾞｲﾝ.円,sel")
        If sel.Count <> 0 Then
            For i = 1 To sel.Count
                objs.Add sel.Item(i).Value
            Next i
        End If

     'objs内のｵﾌﾞｼﾞｪｸﾄをすべて削除
        If objs.Count <> 0 Then
            sel.Clear
            
            Dim obj As AnyObject
            For Each obj In objs
                sel.Add obj
            Next obj
            
            sel.Delete
        End If  
            
    Next pro

End Sub

コード解説

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

 'ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ等定義
    Dim doc As ProductDocument:    Set doc = CATIA.ActiveDocument
    Dim rootpro As Product:        Set rootpro = doc.Product
    Dim sel As Selection:          Set sel = doc.Selection

まずはじめにアクティブドキュメントを定義をします。
ここではやっていませんがTypeName関数を使ってアクティブドキュメントのタイプ別で条件分岐することが多いです。

アクティブドキュメントが定義出来たら、あわせて「RootPuroduct(1番親のProduct)」と「Selectionオブジェクト」を定義します。このSelectionオブジェクトは任意の形状を削除するのに必要になってくるオブジェクトです。
　

Productをすべて設計ﾓｰﾄﾞに変更

 'Productをすべて設計ﾓｰﾄﾞに変更
    Call rootpro.ApplyWorkMode(DESIGN_MODE)

つぎに先ほど定義した「RootProduct(Productオブジェクト)」の「ApplyWorkModeメソッド」を使ってProductをすべて設計モードに切り替えます。

Productのモード切り替え

Productオブジェクト.ApplyWorkMode (モード)
　
※設計=DESIGN_MODE　表示=VISUALIZATION_MODE　デフォルト=DEFAULT_MODE

これは設計モードでないとCATPart内にアクセスすることが出来ないためです。
Productの量によってはこの切り替え時に多少時間がかかりますが、マクロ自体に影響はありません。
　

CATPart(Product)をすべて取得

 'CATPart(Product)をすべて取得
    sel.Search ("ﾌﾟﾛﾀﾞｸﾄ･ｽﾄﾗｸﾁｬｰ.ﾊﾟｰﾂ,all")

    Dim pros As Collection:        Set pros = New Collection
    Dim pro As Product
    
    Dim i As Long
    For i = 1 To sel.Count
        pros.Add sel.Item(i).Value
    Next i

つぎにProductの中でも「CATPart」のProductをすべて取得します。
(ツリーでいうと下画像の赤い座標系が表示されているアイコンのProductのことです)

Slectionオブジェクトの「Searchメソッド」で「"ﾌﾟﾛﾀﾞｸﾄ･ｽﾄﾗｸﾁｬｰ.ﾊﾟｰﾂ,all"」と検索し、結果として引っかかったｊものをすべて「pros」というコレクションに格納します。これによりprosコレクション内ループを行うことで、アクティブドキュメント内のすべてのCATPartに対して処理を行うことが可能になります。

分離したｽｹｯﾁから点の座標をすべて取得

'取得したCATPart(Product)をﾙｰﾌﾟ処理
    For Each pro In pros
    
        Dim partdoc As PartDocument:    Set partdoc = pro.ReferenceProduct.Parent
        Dim pt As Part:                 Set pt = partdoc.Part
        Dim objs As Collection:         Set objs = New Collection

     '直線取得
        sel.Clear
        sel.Add pt
        sel.Search ("ｼﾞｪﾈﾚｰﾃｨﾌﾞ･ｼｪｲﾌﾟ･ﾃﾞｻﾞｲﾝ.直線,sel")
        If sel.Count <> 0 Then
            For i = 1 To sel.Count
                objs.Add sel.Item(i).Value
            Next i
        End If
        
 '**********************************************************************
 '                                 中略
 '**********************************************************************

     'objs内のｵﾌﾞｼﾞｪｸﾄをすべて削除
        If objs.Count <> 0 Then
            sel.Clear
            
            Dim obj As AnyObject
            For Each obj In objs
                sel.Add obj
            Next obj
            
            sel.Delete
        End If  
            
    Next pro

最後にprosコレクション内ループを行い、CATPart内の任意のオブジェクトを削除していきます。

まずはCATPartを「PartDocumentオブジェクト」として取得します。
Product(CATPart)をPartDocumentとして取得するには下記のように書きます。

ProductをPartDocumentとして取得

Productオブジェクト.ReferenceProduct.Parent

あとは通常のCATPart内での処理と同じような考えで進めます。
オブジェクトの削除はSelectionオブジェクトで①選択(Addメソッド) → ②選択オブジェクトを削除(Deleteメソッド)という流れで削除します。

今回は複数のオブジェクトを一括で削除するため「objs」というコレクションを作成し、その中に削除するオブジェクトをまとめて格納、最後にコレクション内をすべて削除という流れにしています。

任意のオブジェクトはSlectionオブジェクトの「Searchメソッド」で指定することができます。
詳しくは上記リンクページのSearchメソッドの項を参照下さい。

基本的には下記コードをコピペしSearch(“")の中身を削除したいオブジェクトに変更すればOKです。何行にも追加していけば、複数のオブジェクトをまとめて削除することができます。(今回でいう4種類のオブジェクトのように)

        sel.Clear
        sel.Add pt
        sel.Search ("照会コード")　'ここの照会コードを書き換えることで、ｵﾌﾞｼﾞｪｸﾄﾀｲﾌﾟ以外にも色や名前などで指定することも可能
        If sel.Count <> 0 Then
            For i = 1 To sel.Count
                objs.Add sel.Item(i).Value
            Next i
        End If