Part内のマテリアルとボディーの表示状態をチェックするマクロ|CATIAマクロの作成方法
今回はLineオープンチャットで頂いた内容です。
送って頂いた内容は以下のようなマクロです。
質問内容:
数百点の”CATPart”が組まれた”CATProduct”の重心位置を求めたいのですが、
その”CATProduct”に組まれている”CATPart”に・マテリアルが未定義のCATPart(ボディーにもマテリアルが適応されていない。)
・CATPart内で非表示のボディーがあるなど
(非表示のボディーも含め重心が計算されてしまうため)、正確な重心位置を求める上で不都合なデータがいくつかあります。
これらの問題となるCATPartをマクロで見つけて、
TXTファイル等に出力するようなマクロは作成可能でしょうか。
マクロの機能
今回作成したマクロは
『Part内のマテリアルとボディーの表示状態をチェックするマクロ』です。
具体的な機能は以下のとおりです。
→ ① マテリアルが設定されていなければエラーリストに追加 ※1
→ ② ボディーが1つでも非表示になっていればエラーリストに追加
・エラーリストに追加された該当CATPartの名称をテキストファイルとして出力
・テキストファイル作成後(マクロ実行後)、テキストを開く
※1 マテリアルはCATPart内に1つでもあればエラー対象外とします。
各ボディーそれぞれに設定されていないといけない訳ではないので注意して下さい。
サンプルコード
マクロのサンプルコードは以下のとおりです。
コード内の「fold_path」には出力するテキストの保存場所を指定する必要があります。
現状のままだとエラーが発生するので、自身の環境に合わせて書き換えて下さい。
また、マクロ実行後すべての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 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 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 |
Option Explicit Dim sel As Selection '関数でも使用するためココで宣言 '----------------------------------------------------------------------------- Sub CATMain() 'アクティブドキュメント定義 If TypeName(CATIA.ActiveDocument) <> "ProductDocument" Then MsgBox "このマクロはProductDocument専用です。" & vbLf & _ "CATProductに切り替えて実行してください。" Exit Sub End If Dim doc As ProductDocument Set doc = CATIA.ActiveDocument Dim pro As Product Set pro = doc.Product pro.ApplyWorkMode (DESIGN_MODE) '全Partを取得 Dim pts As Collection Set pts = New Collection Dim pt 'As Part Dim partdoc As PartDocument Set sel = doc.Selection sel.Search ("パート・デザイン.パーツ,all") '英語.ver→ 'Part Design'.Part,all Dim i As Long For i = 1 To sel.Count pts.Add sel.Item(i).Value Next i '出力用文字列の用意 Dim txt As String txt = "*** Error List ***" 'マテリアル適用と表示/非表示の確認 For Each pt In pts Set partdoc = pt.Parent '関数で確認し片方でも「False」が出たら出力対象 If Not (Check_Material(partdoc) = True And Check_Hide(partdoc) = True) Then txt = txt + vbLf + partdoc.Name End If Next pt 'FileSystemオブジェクト定義 Dim fso 'As FileSystem Set fso = CATIA.FileSystem '出力ファイル名作成 Dim fold_path As String fold_path = "C:\Users\ユーザー名\Desktop\" '最後に"\"を付けたフォルダパス Dim file_name As String file_name = pro.Name & ".txt" Dim file_path As String file_path = fold_path & file_name '出力ファイルの作成 Dim txt_file As File Set txt_file = fso.CreateFile(file_path, True) Open file_path For Output As #1 Print #1, txt Close #1 '出力したテキストを開く Shell "C:\Windows\Explorer.exe " & file_path, vbNormalFocus End Sub '----------------------------------------------------------------------------- ' 関数:Check_Material ' 機能:引数のPartDocument内のマテリアルの適用を確認する ' マテリアルがドキュメント内に1つでもあれば「True」なければ「False」を返す '----------------------------------------------------------------------------- Function Check_Material(ByVal doc As PartDocument) As Boolean sel.Clear sel.Add doc.Part sel.Search ("((プロダクト・ストラクチャー.マテリアル + アセンブリー・デザイン.マテリアル) + レンダリング.マテリアル),sel") '英語.ver→ ('Product Structure'.Material + 'Assembly Design'.Material),sel If sel.Count = 0 Then Check_Material = False Else Check_Material = True End If sel.Clear End Function '----------------------------------------------------------------------------- ' 関数:Check_Hide ' 機能:引数のPartDocument内にあるボディーの表示/非表示を確認する ' 非表示ボディーがドキュメント内に1つでもあれば「False」なければ「True」を返す '----------------------------------------------------------------------------- Function Check_Hide(ByVal doc As PartDocument) As Boolean Dim vps As VisPropertySet Set vps = sel.VisProperties Dim i As Long Dim bs As Collection Set bs = New Collection Dim b 'As Body Dim state As CatVisPropertyShow sel.Clear sel.Add doc.Part sel.Search ("パート・デザイン.ボディー,sel") '英語.ver→ 'Part Design'.Body,sel For i = 1 To sel.Count bs.Add sel.Item(i).Value Next i For Each b In bs sel.Clear sel.Add b vps.GetShow state If state = catVisPropertyNoShowAttr Then Check_Hide = False sel.Clear Exit Function End If Next b Check_Hide = True sel.Clear End Function |
コード解説
アクティブドキュメント/RootProduct定義
1 2 3 4 5 6 7 8 9 10 11 12 13 14 |
'アクティブドキュメント定義 If TypeName(CATIA.ActiveDocument) <> "ProductDocument" Then MsgBox "このマクロはProductDocument専用です。" & vbLf & _ "CATProductに切り替えて実行してください。" Exit Sub End If Dim doc As ProductDocument Set doc = CATIA.ActiveDocument Dim pro As Product Set pro = doc.Product pro.ApplyWorkMode (DESIGN_MODE) |
まずはじめにアクティブドキュメントの定義をします。
今回のマクロはCATProductでのみ有効なものなので、アクティブドキュメントがCATProduct以外の場合はTypeName関数を使った条件分岐でマクロを終了するようにしています。条件分岐の先、つまりはアクティブドキュメントがCATProductの場合は変数「doc」にアクティブドキュメントを代入します。
アクティブドキュメントを定義したら合わせてRootProduct(一番親のProduct)も定義します。
RootProductを定義したら、それを使いすべてのProduct(Part)をデザインモードに変換します。
Productオブジェクト.ApplyWorkMode(モード)
※設計モード = DESIGN_MODE
表示モード = VISUALIZATION_MODE
デフォルトモード = DEFAULT_MODE
全Partを取得
1 2 3 4 5 6 7 8 9 10 11 12 13 |
'全Partを取得 Dim pts As Collection Set pts = New Collection Dim pt 'As Part Dim partdoc As PartDocument Set sel = doc.Selection sel.Search ("パート・デザイン.パーツ,all") '英語.ver→ 'Part Design'.Part,all Dim i As Long For i = 1 To sel.Count pts.Add sel.Item(i).Value Next i |
つぎにProduct内にあるすべての「Part」を取得します。
さきほどすべてのProduct(Part)をデザインモードに変更したため、SelectionオブジェクトのSerachメソッドで「パーツ」検索をかければすべての「Part」を選択状態にできます。
あとは「選択しているオブジェクトを一時保管する方法」でも説明しているとおりの方法ですべての「Part」を「pts」というコレクションに格納します。
マテリアル適用と表示/非表示の確認
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 |
'出力用文字列の用意 Dim txt As String txt = "*** Error List ***" 'マテリアル適用と表示/非表示の確認 For Each pt In pts Set partdoc = pt.Parent '関数で確認し片方でも「False」が出たら出力対象 If Not (Check_Material(partdoc) = True And Check_Hide(partdoc) = True) Then txt = txt + vbLf + partdoc.Name End If Next pt |
つぎに「pts」コレクション内の「Part」の中身をチェックして、「①マテリアルが設定されているか」「②ボディーが非表示になっていないか」を確認し、設定されていないPartはその名称を「txt」という変数に追加していきます。
「①マテリアルが設定されているか」「②ボディーが非表示になっていないか」のチェックはそれぞれ専用の関数「①Check_Material」「②Check_Hide」を使用しています。両関数の返り値が「True」でない場合はマテリアルが設定されていないか、ボディーが非表示になっているため、「txt」へ追加する対象のPartということになります。
テキスト出力
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 |
'FileSystemオブジェクト定義 Dim fso 'As FileSystem Set fso = CATIA.FileSystem '出力ファイル名作成 Dim fold_path As String fold_path = "C:\Users\ユーザー名\Desktop\" '最後に"\"を付けたフォルダパス Dim file_name As String file_name = pro.Name & ".txt" Dim file_path As String file_path = fold_path & file_name '出力ファイルの作成 Dim txt_file As File Set txt_file = fso.CreateFile(file_path, True) Open file_path For Output As #1 Print #1, txt Close #1 |
つぎに「txt」の中身をテキストファイルに出力していきます。
「FileSystemオブジェクト」のCreateFileメソッドを使って新規テキストファイルを作成します。
テキストファイルの保存場所となる「fold_path」は自身の環境に合わせて書き換えて下さい。
テキストファイルの作成が完了したら、そのファイルに「txt」の中身を書き出します。
「Open file_path For Output As #1」でテキストを開き、
「Print #1, txt」で「txt」を書き出し、
「Close #1」でテキストファイルを閉じるというVBAでは基本的な書き出しの処理をしています。
出力したテキストを開く
1 2 |
'出力したテキストを開く Shell "C:\Windows\Explorer.exe " & file_path, vbNormalFocus |
最後に「Shell関数」を使ってテキストファイルを表示させます。
詳しい使い方は「VBA Shell関数」などで検索して見て下さい。
Check_Material関数
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 |
'----------------------------------------------------------------------------- ' 関数:Check_Material ' 機能:引数のPartDocument内のマテリアルの適用を確認する ' マテリアルがドキュメント内に1つでもあれば「True」なければ「False」を返す '----------------------------------------------------------------------------- Function Check_Material(ByVal doc As PartDocument) As Boolean sel.Clear sel.Add doc.Part sel.Search ("((プロダクト・ストラクチャー.マテリアル + アセンブリー・デザイン.マテリアル) + レンダリング.マテリアル),sel") '英語.ver→ ('Product Structure'.Material + 'Assembly Design'.Material),sel If sel.Count = 0 Then Check_Material = False Else Check_Material = True End If sel.Clear End Function |
Check_Material関数は引数として入力されたCATPart内にマテリアルが設定されているかを調べる関数です。マテリアルがCATPart内に1つでもあれば「True」、1つも存在しなければ「False」を返すようになっています。
処理としてはCATPart内で、SelectionオブジェクトのSerachメソッドで「マテリアル」検索をしているだけです。この結果、「選択状態が0であるということはマテリアルが存在していない」という判定を出しています。
Check_Material関数
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 |
'----------------------------------------------------------------------------- ' 関数:Check_Hide ' 機能:引数のPartDocument内にあるボディーの表示/非表示を確認する ' 非表示ボディーがドキュメント内に1つでもあれば「False」なければ「True」を返す '----------------------------------------------------------------------------- Function Check_Hide(ByVal doc As PartDocument) As Boolean Dim vps As VisPropertySet Set vps = sel.VisProperties Dim i As Long Dim bs As Collection Set bs = New Collection Dim b 'As Body Dim state As CatVisPropertyShow sel.Clear sel.Add doc.Part sel.Search ("パート・デザイン.ボディー,sel") '英語.ver→ 'Part Design'.Body,sel For i = 1 To sel.Count bs.Add sel.Item(i).Value Next i For Each b In bs sel.Clear sel.Add b vps.GetShow state If state = catVisPropertyNoShowAttr Then Check_Hide = False sel.Clear Exit Function End If Next b Check_Hide = True sel.Clear End Function |
Check_Hide関数は引数として入力されたCATPart内のボディーが非表示になっていないかを調べる関数です。ボディーが全て表示状態であれば「True」、1つでも非表示のものがあれば「False」を返すようになっています。
処理としてはCheck_Material関数とほぼ同じでCATPart内で、SelectionオブジェクトのSerachメソッドで「ボディー」検索をしているだけです。
Check_Material関数と違うのはその後にVisPropertySetオブジェクトでボディーの表示状態を確認しているところです。「GetShowメソッド」で取得した結果が「catVisPropertyNoShowAttr」となっているものは非表示状態になっていることを表しています。つまり1つでも「catVisPropertyNoShowAttr」のものがあれば即「False」を返す関数となっています。
まとめ
今回は「Part内のマテリアルとボディーの表示状態をチェックするマクロ」についてでした。
マクロの基本の流れとしては下記の通りです。
② Part内でマテリアル確認 →Check_Material関数
③ Part内でボディーの表示状態確認 →Check_Hide関数
④ 対象のPartをテキストに出力
上記の通りチェックする内容ごとに関数を作成しているので、条件を追加したり、変更しやすくなっています。たとえば「形状セット確認」のような要素も加えたければ「Check_hb」のような関数を作成すればすぐに盛り込むことができます。