選択したBody別に新規CATPartとして作成する｜CATIAマクロの作成方法
今回の記事はマクロ案募集でいただいた内容です。
送って頂いた内容は以下のようなマクロです。
ワークベンチ: パートデザイン
マクロ案: 一つのCATPart内にある複数のBodyを選択し、 それぞれを1Bodyごと新しいCATPartにコピー
(ここで履歴無し、履歴有り、 リンク付きコピーが選べると嬉しいです)
その際、 個々のBody名が個々のCATPartのファイル名としてコピーされる。
そして、 作られた全てのCATPartを自動的に新しく作成したProductにまとめてくれるマクロ。
コピペの方法が選べた方がいいということでその機能も付けています。
ただBody別に選ぶのか、まとめて選ぶのかが読み取れなかったため、本記事では単純に作成できる「まとめて選ぶ」を採用しています。(Body別の場合はおそらくUserFormを使う必要があります)
ちなみに今回のマクロと似た内容が下記サイトでも解説されています。
当サイトよりしっかりとしたコードで書かれているため合わせて読んでみて下さい。
https://kantoku.hatenablog.com/entry/2017/10/03/182925
マクロの機能
今回作成したマクロは
選択したBody毎に新規CATPartに貼り付け、1つのCATProductにまとめるマクロです。
具体的な機能は以下のとおりです。
・選択状態のBodyをそれぞれ新規CATPartに出力(CATPartの名称はBodyと同じ)
・空のBodyを選択している場合は空のCATPartが作成される
・作成した新規CATPartは1つのCATProductにまとめる
・CATPartに貼り付ける方法の指定が可能
「1」を入力すれば通常ペースト(履歴有り)
「2」を入力すればリンク付きペースト
「3」を入力すれば結果としてペースト(履歴無し)
※指定した方法で”すべて”のBodyが貼り付けられる
新規作成したCATPart/CATProductはいずれも保存されていない状態なので注意して下さい。
サンプルコード
マクロのコードは以下のとおりです。
出力したいBodyを選択した状態 で以下のコードを実行します。
実行後InputBoxが立ち上がるので、貼り付け方法を1、2、3のいずれかから選び、その数字を入力します。入力した数字の貼り付け方法ですべてのBodyが新規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 |
Option Explicit Sub CATMain() If TypeName(CATIA.ActiveDocument) = "PartDocument" Then Dim PARTDOC As PartDocument Set PARTDOC = CATIA.ActiveDocument Else MsgBox "このマクロはPartDocument専用です。" & vbLf & _ "パート・デザインワークベンチに切り替えて実行してください。" Exit Sub End If Dim SEL As Selection Set SEL = PARTDOC.Selection Debug.Print SEL.Count If SEL.Count = 0 Then MsgBox "Bodyを1つ以上選択して下さい。" Exit Sub End If Dim i As Integer Dim SELItemArray() ReDim SELItemArray(SEL.Count - 1) For i = 1 To SEL.Count Set SELItemArray(i - 1) = SEL.Item(i).Value Next i Dim PasteStyle Dim msg As String msg = "貼り付け方法を入力して下さい。" & vbLf & vbLf & _ "1.ﾊﾟｰﾂﾄﾞｷｭﾒﾝﾄで指定されている通り" & vbLf & _ "2.ﾘﾝｸの結果として" & vbLf & _ "3.結果として" & vbLf & vbLf & _ "1.As specified in Part document" & vbLf & _ "2.As Result with Link" & vbLf & _ "3.As Result" & vbLf label1: PasteStyle = InputBox(msg, "貼り付け方法選択", 1) If PasteStyle = "" Then MsgBox "キャンセルしました。" Exit Sub ElseIf PasteStyle < 1 Or PasteStyle > 3 Then MsgBox "1,2,3のいずれかの数値を入力して下さい。" GoTo label1 End If Dim PRODOC As ProductDocument Set PRODOC = CATIA.Documents.Add("Product") Dim RootPROs 'As Products Set RootPROs = PRODOC.Product.Products Dim j As Integer For j = 1 To SEL.Count Set SEL = PARTDOC.Selection Dim SELBody Set SELBody = SEL.Item(j).Value If TypeName(SELBody) = "Body" Then Call RootPROs.AddNewComponent("Part", SELBody.Name) Dim NewPARTDOC As PartDocument Set NewPARTDOC = RootPROs.Item(RootPROs.Count).ReferenceProduct.Parent SEL.Clear SEL.Add SELBody SEL.Copy SEL.Clear Set SEL = PRODOC.Selection SEL.Add NewPARTDOC.Part If PasteStyle = 1 Then 'ﾊﾟｰﾂﾄﾞｷｭﾒﾝﾄで指定されている通り(As specified in Part document) SEL.PasteSpecial "CATPrtCont" ElseIf PasteStyle = 2 Then 'ﾘﾝｸの結果として(As Result with Link) SEL.PasteSpecial "CATPrtResult" ElseIf PasteStyle = 3 Then '結果として(As Result) SEL.PasteSpecial "CATPrtResultWithOutLink" End If NewPARTDOC.Part.Update SEL.Clear Set SEL = PARTDOC.Selection End If SEL.Clear Dim k As Integer For k = 0 To UBound(SELItemArray) SEL.Add SELItemArray(k) Next k Next j End Sub |
かなり無理やりやっている感は否めませんが、おそらく実行自体は可能だと思います。
コード解説
基本的には手動でやる操作をそのままVBAで書いたようなイメージです。
(「選択 → コピー → 貼り付け」の繰り返し)
アクティブドキュメントの定義
|
1 2 3 4 5 6 7 8 |
If TypeName(CATIA.ActiveDocument) = "PartDocument" Then Dim PARTDOC As PartDocument Set PARTDOC = CATIA.ActiveDocument Else MsgBox "このマクロはPartDocument専用です。" & vbLf & _ "パート・デザインワークベンチに切り替えて実行してください。" Exit Sub End If |
まずはじめにアクティブドキュメントの定義をします。
今回のマクロはCATPartでのみ有効なものなので、アクティブドキュメントがCATPart以外の場合はTypeName関数を使った条件分岐でマクロを終了するようにしています。
つまり、アクティブドキュメントがCATPartの場合のみ変数「PARTDOC」にアクティブドキュメントを代入し、マクロの処理を続けます。
Selectionオブジェクトの定義
|
1 2 3 4 5 6 7 8 9 |
Dim SEL As Selection Set SEL = PARTDOC.Selection Debug.Print SEL.Count If SEL.Count = 0 Then MsgBox "Bodyを1つ以上選択して下さい。" Exit Sub End If |
Selectionオブジェクトの定義をします。
ここでは先ほど定義したアクティブドキュメント(PartDocument)内のSelectionを定義しています。(※この後で別のドキュメントで再定義するということを頭の片隅に入れておいて下さい)
Selectionオブジェクトの定義と合わせて、現在選択されているものがあるかの確認を行います。
「SEL.Count=0」つまりは選択状態のものが何もない場合はマクロを中断するよう条件分岐をさせています。
選択状態のオブジェクトをすべて配列に格納
|
1 2 3 4 5 6 7 |
Dim i As Integer Dim SELItemArray() ReDim SELItemArray(SEL.Count - 1) For i = 1 To SEL.Count Set SELItemArray(i - 1) = SEL.Item(i).Value Next i |
ループ文を使って選択状態のオブジェクトをすべて配列に格納します。
これはCATPartとCATProductの両ドキュメントで「選択」という操作をするために用意しています。
ここでは、ユーザーが選択したオブジェクトを見失わないように一時保管している箱だと思っておけば大丈夫です。
貼り付け方法のユーザー選択
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 |
Dim PasteStyle Dim msg As String msg = "貼り付け方法を入力して下さい。" & vbLf & vbLf & _ "1.ﾊﾟｰﾂﾄﾞｷｭﾒﾝﾄで指定されている通り" & vbLf & _ "2.ﾘﾝｸの結果として" & vbLf & _ "3.結果として" & vbLf & vbLf & _ "1.As specified in Part document" & vbLf & _ "2.As Result with Link" & vbLf & _ "3.As Result" & vbLf label1: PasteStyle = InputBox(msg, "貼り付け方法選択", 1) If PasteStyle = "" Then MsgBox "キャンセルしました。" Exit Sub ElseIf PasteStyle < 1 Or PasteStyle > 3 Then MsgBox "1,2,3のいずれかの数値を入力して下さい。" GoTo label1 End If |
InputBox関数を使いBodyの貼り付け方法をユーザーに選択させます。
「×」「キャンセル」が押された場合はマクロを中断しますが、１より小さい、もしくは３より大きい数字、数字以外の文字列が入力された場合はGoTo文を使って再度InputBoxを開くようにしています。
最終的にはここで入力された「1」「2」「3」の数字を使って条件分岐を行います。
※上記の条件を突破するには１以上、３以下の数字の入力が必須となっています。
これは1、2、3を入力させるための条件ですが、1.5や2.3などもこれに含まれてしまいます。
気にならない場合はいいですがここの条件は書き換えることをオススメします。
新規CATProductの作成/定義
|
1 2 3 4 5 |
Dim PRODOC As ProductDocument Set PRODOC = CATIA.Documents.Add("Product") Dim RootPROs 'As Products Set RootPROs = PRODOC.Product.Products |
新規CATProductの作成は「Documentsコレクション」の「Addメソッド」を使います。
作成したCATProductを「PRODOC」として定義したら、あわせて一番上にあるProduct(RootProductともいう)内の「Productsコレクション」を定義します。
新規CATPartにBodyをコピペ
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 |
Dim j As Integer For j = 1 To SEL.Count Set SEL = PARTDOC.Selection Dim SELBody Set SELBody = SEL.Item(j).Value If TypeName(SELBody) = "Body" Then Call RootPROs.AddNewComponent("Part", SELBody.Name) Dim NewPARTDOC As PartDocument Set NewPARTDOC = RootPROs.Item(RootPROs.Count).ReferenceProduct.Parent SEL.Clear SEL.Add SELBody SEL.Copy SEL.Clear Set SEL = PRODOC.Selection SEL.Add NewPARTDOC.Part |
ループ文を使い新規でCATPartを作成し、選択しているBodyをコピぺしていきます。
ここでは条件分岐を使って選択オブジェクトが「Body」の場合のみ処理を行うようにしています。
Body以外のオブジェクトが選択されている場合は特に何も処理はされずにマクロが進みます。
新規CATPartの作成は先ほど定義した「Productsコレクション」の「AddNewComponentメソッド」を使って行います。
CATPart作成後はコピペ処理です。
ここで注意しないといけないのはコピー元、貼り付け先のドキュメントが違う点です。
‘CATPartのSelection
SEL.Clear ‘選択をすべて解除
SEL.Add SELBody ‘j番目のBodyを選択
SEL.Copy ‘コピー
SEL.Clear ‘選択をすべて解除
‘以下からCATProductのSelection
Set SEL = PRODOC.Selection ‘CATProductのSelectionとして再定義
SEL.Add NewPARTDOC.Part ‘新規作成したCATPartを選択
BodyのコピーまではCATPartですが、次の選択/貼り付けという操作はCATProductで行うため、上記のようにSelectionオブジェクトを再定義しています。
上記までのコードで新規作成したCATPartが選択状態となります。
以下ではこの選択状態のCATPartに「貼り付け(ペースト)」を行っていきます。
Bodyの貼り付け
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 |
If PasteStyle = 1 Then 'ﾊﾟｰﾂﾄﾞｷｭﾒﾝﾄで指定されている通り(As specified in Part document) SEL.PasteSpecial "CATPrtCont" ElseIf PasteStyle = 2 Then 'ﾘﾝｸの結果として(As Result with Link) SEL.PasteSpecial "CATPrtResult" ElseIf PasteStyle = 3 Then '結果として(As Result) SEL.PasteSpecial "CATPrtResultWithOutLink" End If NewPARTDOC.Part.Update SEL.Clear Set SEL = PARTDOC.Selection End If |
InputBoxで取得した数字別に条件分岐を行います。
それぞれ「Selectionオブジェクト」の「PasteSpecialメソッド」を使います。
貼り付け後はCATPartの更新を行う必要があるため「Updateメソッド」を使います。
最後にSelectionオブジェクトを再度CATPartドキュメントのSelectionに再定義します。
CATPartのユーザー選択オブジェクトを再選択
|
1 2 3 4 5 6 7 8 |
SEL.Clear Dim k As Integer For k = 0 To UBound(SELItemArray) SEL.Add SELItemArray(k) Next k Next j |
現在CATPartでは選択状態のオブジェクトは何もない状態です。
このままではループがうまくいかないため、再度ユーザーが選択したオブジェクトを選択状態にしループが成立するようにします。
ユーザー選択オブジェクトはすべてSELItemArray配列に入れておいたため、ループ文を使ってすべて選択状態とします。
あとはループが正常に回り、ユーザー選択のBodyがすべてCATPartに貼り付けられていきます。
まとめ
今回は選択したBodyをすべてCATPartに貼り付け、1つのCATProductにまとめるマクロについての内容でした。
貼り付け方法の選択にInputBox関数を使いましたが、UserFormを使うことでより直感的に操作ができるマクロすることができると思います。
細かいエラー処理やもやっておらず、強引にペーストしているため予期せぬところでエラーが発生する可能性があります。
本ページと、冒頭で紹介したページを合わせればどのようなコードを書けばいいのかある程度は理解できると思うので、自身で都合のいいように書き換えて頂ければ幸いです。
今回のサンプルマクロはあくまでも”参考程度”にしておいてください。
※Body別に貼り付け方法を選ぶバージョンのマクロがほしい方は、以下のリンクページの「マクロ案」からご連絡ください。
CATIAマクロを本気で勉強するなら
