選択したBody別に新規CATPartとして作成する｜CATIAマクロの作成方法

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

ワークベンチ: パートデザイン

マクロ案: 一つのCATPart内にある複数のBodyを選択し、 それぞれを1Bodyごと新しいCATPartにコピー
　　　　  (ここで履歴無し、履歴有り、 リンク付きコピーが選べると嬉しいです)
             その際、 個々のBody名が個々のCATPartのファイル名としてコピーされる。
             そして、 作られた全てのCATPartを自動的に新しく作成したProductにまとめてくれるマクロ。

コピペの方法が選べた方がいいということでその機能も付けています。
ただBody別に選ぶのか、まとめて選ぶのかが読み取れなかったため、本記事では単純に作成できる「まとめて選ぶ」を採用しています。(Body別の場合はおそらくUserFormを使う必要があります)

ちなみに今回のマクロと似た内容が下記サイトでも解説されています。
当サイトよりしっかりとしたコードで書かれているため合わせて読んでみて下さい。

 

マクロの機能

今回作成したマクロは
選択したBody毎に新規CATPartに貼り付け、1つのCATProductにまとめるマクロです。

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

 icon-wrench マクロの機能まとめ ・CATPartに出力(ペースト)したいBodyを選択してからマクロを実行
・選択状態のBodyをそれぞれ新規CATPartに出力(CATPartの名称はBodyと同じ)
・空のBodyを選択している場合は空のCATPartが作成される
・作成した新規CATPartは1つのCATProductにまとめる
・CATPartに貼り付ける方法の指定が可能
 「1」を入力すれば通常ペースト(履歴有り)
 「2」を入力すればリンク付きペースト
 「3」を入力すれば結果としてペースト(履歴無し)
※指定した方法で"すべて"のBodyが貼り付けられる

新規作成したCATPart/CATProductはいずれも保存されていない状態なので注意して下さい。

 

サンプルコード

マクロのコードは以下のとおりです。
 出力したいBodyを選択した状態 で以下のコードを実行します。

実行後InputBoxが立ち上がるので、貼り付け方法を1、2、3のいずれかから選び、その数字を入力します。入力した数字の貼り付け方法ですべてのBodyが新規CATPartに貼り付けられます。

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で書いたようなイメージです。
(「選択 → コピー → 貼り付け」の繰り返し)

アクティブドキュメントの定義

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オブジェクトの定義

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」つまりは選択状態のものが何もない場合はマクロを中断するよう条件分岐をさせています。
　

選択状態のオブジェクトをすべて配列に格納

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の両ドキュメントで「選択」という操作をするために用意しています。

ここでは、ユーザーが選択したオブジェクトを見失わないように一時保管している箱だと思っておけば大丈夫です。
　

貼り付け方法のユーザー選択

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の作成/定義

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をコピペ

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作成後はコピペ処理です。
ここで注意しないといけないのはコピー元、貼り付け先のドキュメントが違う点です。

 icon-code Selectionオブジェクトの切り替え

'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の貼り付け

　　　　　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のユーザー選択オブジェクトを再選択

　　 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別に貼り付け方法を選ぶバージョンのマクロがほしい方は、以下のリンクページの「マクロ案」からご連絡ください。
　

目次へ戻る
 

icon-book CATIAマクロを本気で勉強するなら

Vb Scripting for Catia V5: How to Program Catia Macros
created by Rinker
CATIA V5: Macro Programming with Visual Basic Script
created by Rinker
McGraw-Hill Education

2024年9月11日CATIA,CATIAマクロ