CATProduct内にある任意の形状を一括で削除するマクロ｜CATIAマクロの作成方法
今回の記事はマクロ案募集よりいただいた内容です。
送って頂いた内容は以下のようなマクロです。
ワークベンチ:
CATProductマクロ案:
サーフェス以外を選択し削除する。
すなわち、作図に使った直線、点、曲線、円を一括で削除したい。
今回マクロで行う処理は直線他店を削除するという「CATPart」での処理です。
これをアクティブドキュメントが「CATProduct」の状態で行うには、Product内にあるCATPartをすべて取得する必要があります。CATProductのマクロはProductとPartの関係が少し難しいですが、今回のマクロが理解できればある程度のイメージが付くと思います。
マクロの機能
今回作成したのはCATProduct内にある任意の形状を一括で削除するマクロです。
今回のマクロではお問い合わせ頂いた4種類のオブジェクトしか削除しませんが、コードを少し書き換えれば任意のオブジェクトをまとめて削除することが可能になります。
具体的な機能は以下のとおりです。
・※履歴で繋がっている場合にエラーが発生する場合あり(リンクが切れていること前提)
オブジェクト削除後、形状セットが空になってもセットを削除する機能はないので、任意でコードに追加してみて下さい。
サンプルコード
マクロのコードは以下のとおりです。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 |
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定義
|
1 2 3 4 |
'ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ等定義 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をすべて設計ﾓｰﾄﾞに変更
|
1 2 |
'Productをすべて設計ﾓｰﾄﾞに変更 Call rootpro.ApplyWorkMode(DESIGN_MODE) |
つぎに先ほど定義した「RootProduct(Productオブジェクト)」の「ApplyWorkModeメソッド」を使ってProductをすべて設計モードに切り替えます。
Productオブジェクト.ApplyWorkMode (モード)
※設計=DESIGN_MODE 表示=VISUALIZATION_MODE デフォルト=DEFAULT_MODE
これは設計モードでないとCATPart内にアクセスすることが出来ないためです。
Productの量によってはこの切り替え時に多少時間がかかりますが、マクロ自体に影響はありません。
CATPart(Product)をすべて取得
|
1 2 3 4 5 6 7 8 9 10 |
'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に対して処理を行うことが可能になります。
分離したｽｹｯﾁから点の座標をすべて取得
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 |
'取得した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オブジェクト.ReferenceProduct.Parent
あとは通常のCATPart内での処理と同じような考えで進めます。
オブジェクトの削除はSelectionオブジェクトで①選択(Addメソッド) → ②選択オブジェクトを削除(Deleteメソッド)という流れで削除します。
今回は複数のオブジェクトを一括で削除するため「objs」というコレクションを作成し、その中に削除するオブジェクトをまとめて格納、最後にコレクション内をすべて削除という流れにしています。
任意のオブジェクトはSlectionオブジェクトの「Searchメソッド」で指定することができます。
詳しくは上記リンクページのSearchメソッドの項を参照下さい。
基本的には下記コードをコピペしSearch(“”)の中身を削除したいオブジェクトに変更すればOKです。何行にも追加していけば、複数のオブジェクトをまとめて削除することができます。(今回でいう4種類のオブジェクトのように)
|
1 2 3 4 5 6 7 8 |
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 |
まとめ
今回はCATProduct内にある任意の形状を一括で削除するマクロについての内容でした。
冒頭でもいっていたとおり、CATProduct内のCATPartの処理となると少し複雑で難しく感じます。
しかし、今回のように下記のコードでPartDocumentオブジェクトとしてCATPartを取得することができるため、通常のCATPartマクロのように扱うことが可能になります。
Productオブジェクト.ReferenceProduct.Parent
他にも「新しいウィンドウで開く(Open in New Window)」を使ってCATProductから新たなウィンドウで開かせることで、こちらも通常のCATPartマクロのように扱うことが出来ます。
仕事内容やユーザーのことを考え、マッチする方法を採用して下さい。
CATIAマクロを本気で勉強するなら
