Productから作成したCATPartを元のProduct構成に戻すマクロ|CATIAマクロの作成方法

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

⑤プロダクトを履歴なしのプロダクトを作成
  準備
  「プロダクトからcatpartを生成」で出力したパートを作成
   ↓  
  マクロ実行&結果 
   用意したパートでボディや形状セット名の¥を利用してプロダクト 化へ

はじめに言っておくと今回のマクロでは完全に同じProduct構成を再現することはできません。
これは準備として生成するCATPartが「インスタンス名」で出力されることが深く関係してきます。
詳しくは本文で解説していきますが、この前提はあらかじめ理解しておいてください。

 

マクロの機能

今回作成したマクロは
『Productから作成したCATPartを元のProduct構成を再現するマクロ』です。

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

  マクロの機能まとめ ・[ツール]>[プロダクトからCATPartを生成]で作成されたCATPart内で実行可能
   (Partの名称に「_AllCATPart」と入っていることで判断する)
・形状セット/ボディーの名称から同一のProduct構成を再現する
同Product/Partが複数使われている場合はうまく実行できないので注意

今回のマクロでは、形状セット/ボディーの名称からProductやPartの名前を取得して、同名のProductやPartを作成するという流れの処理を行ないます。

ここで問題なのが、[プロダクトからCATPartを生成]で作成された形状セット/ボディーの名称はインスタンス名だけという点です。インスタンス名は同一名称になることはなく、かつユーザーが好きなように変更することができます。

これにより元のProduct構成を再現することが難しいため、本マクロでは同Product/Partが複数使われている場合の処理は未対応になっています。(インスタンスもとのプロダクトのパーツ番号が取得できないと、複数のプロダクトのオリジナルが同一のプロダクトかを確認することができないことが大きな原因の1つです)

また簡単なProduct構成でしか処理の結果を確認できていないので、膨大なProductではもしかしたらうまくいかない可能性があるのであらかじめご了承ください。

 

サンプルコード

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

Option Explicit
Option Base 1
'―――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
Sub CATMain()

    If TypeName(CATIA.ActiveDocument) <> "PartDocument" Then
        MsgBox "プロダクトから生成されたCATPart専用マクロです。"
        Exit Sub
    End If
    
    Dim Doc As PartDocument
    Set Doc = CATIA.ActiveDocument
    
    Dim PT As Part
    Set PT = Doc.Part
    
    
'「プロダクトからCATPartを生成」で作成されたCATPartかを判定

    Dim NameCheck As Integer
    NameCheck = InStr(1, PT.Name, "_AllCATPart")

    If NameCheck = 0 Then
        MsgBox "プロダクトから生成されたCATPart専用マクロです。"
        Exit Sub
    End If
    
    
    Dim ExportPro As ProductDocument
    Set ExportPro = CATIA.Documents.Add("Product")

    Dim RootPro As Product
    Set RootPro = ExportPro.Product

    Dim RootPros As Products
    Set RootPros = RootPro.Products

    On Error Resume Next
        RootPro.PartNumber = Replace(PT.Name, "_AllCATPart", "")
    On Error GoTo 0
    
'出力された形状セットとボディーをすべて取得
    
    Dim HBCount As Integer
    
    Dim SEL As Selection
    Set SEL = Doc.Selection
    
    SEL.Search ("ジェネレーティブ・シェイプ・デザイン.形状セット,all")
    
    Dim SELColl As Collection
    Set SELColl = New Collection
    
    HBCount = SEL.Count '形状セットの数を取得
    
    Dim i As Integer
    For i = 1 To SEL.Count
        SELColl.Add SEL.Item(i).Value
    Next i
    
    SEL.Clear
    SEL.Search ("パート・デザイン.ボディー,all")
    SEL.Remove 1 'パーツ・ボディーを選択から除去
    
    For i = 1 To SEL.Count
        SELColl.Add SEL.Item(i).Value
    Next i
    
    SEL.Clear


'ループで新規Productに出力

    CATIA.RefreshDisplay = False
    
    Dim j As Integer
    Dim SepCnt As Integer
    Dim CreateProNameArray() As String
    Dim ProNameArray() As String
    Dim cnt As Integer
    Dim ProNameCheck As Boolean
    
    Dim NewPros 'As Products
    Dim NewPro 'As Product
    Dim NewPartDoc As PartDocument
    Dim NewPart As Part
    Dim NewPartHBs As HybridBodies
    Dim NewPartBodies As Bodies
    
    ReDim CreateProNameArray(1)
    
    For i = 1 To SELColl.Count
    
        Set NewPros = RootPros
    
        '[\]の個数をカウント
        SepCnt = Len(SELColl.Item(i).Name) - Len(Replace(SELColl.Item(i).Name, "\", ""))
        
        ProNameArray = Split(SELColl.Item(i).Name, "\")
            
        For j = 0 To UBound(ProNameArray)
            DoEvents
            cnt = 1
            ProNameCheck = False
            Do
                DoEvents
                If ProNameArray(j) = CreateProNameArray(cnt) Then
                    ProNameCheck = True
                End If
                
                If cnt = UBound(CreateProNameArray) Then
                    Exit Do
                End If
                
                cnt = cnt + 1
            Loop
            
            If j = UBound(ProNameArray) - 1 Then  'Part処理
            
                If ProNameCheck = False Then
                
                    Set NewPro = NewPros.AddNewComponent("Part", "")
                    On Error Resume Next
                        NewPro.Name = ProNameArray(j)
                        NewPro.PartNumber = ProNameArray(j)
                    On Error GoTo 0
                    Set NewPartDoc = NewPro.ReferenceProduct.Parent
    
                    CreateProNameArray(UBound(CreateProNameArray)) = ProNameArray(j)
                    ReDim Preserve CreateProNameArray(UBound(CreateProNameArray) + 1)
                Else
                
                    On Error Resume Next
                        Set NewPro = NewPros.Item(ProNameArray(j))
                        Set NewPartDoc = NewPro.ReferenceProduct.Parent
                    On Error GoTo 0
                        
                End If
            
            ElseIf j = UBound(ProNameArray) Then  '形状セット/ボディー処理
            
                If ProNameCheck = False Then
                
                    Set NewPart = NewPartDoc.Part
                    Set NewPartHBs = NewPart.HybridBodies
                    Set NewPartBodies = NewPart.Bodies

                    SEL.Add SELColl(i)
                    SEL.Copy
                    SEL.Clear

                    Set SEL = ExportPro.Selection 'SelectionをCATProductに変更
                    SEL.Add NewPart
                    SEL.Paste
                    SEL.Clear
                    
                    On Error Resume Next
                        NameCheck = InStr(1, NewPartHBs.Item(NewPartHBs.Count).Name, "\")
                        
                        If NameCheck <> 0 Then
                            NewPartHBs.Item(NewPartHBs.Count).Name = ProNameArray(j)
                        End If
                        
                        NameCheck = InStr(1, NewPartBodies.Item(NewPartBodies.Count).Name, "\")
                        
                        If NameCheck <> 0 Then
                            NewPartBodies.Item(NewPartBodies.Count).Name = ProNameArray(j)
                        End If
                    On Error GoTo 0

                    NewPart.Update
                    Set SEL = Doc.Selection 'SelectionをCATPartに変更
                
                End If
            
            Else  'Product処理
            
                If ProNameCheck = False Then
                
                    Set NewPro = NewPros.AddNewComponent("Product", "")
                    On Error Resume Next
                        NewPro.Name = ProNameArray(j)
                        NewPro.PartNumber = ProNameArray(j)
                    On Error GoTo 0
                    Set NewPros = NewPro.Products
    
                    CreateProNameArray(UBound(CreateProNameArray)) = ProNameArray(j)
                    ReDim Preserve CreateProNameArray(UBound(CreateProNameArray) + 1)
                
                Else
                    
                    On Error Resume Next
                        Set NewPro = NewPros.Item(ProNameArray(j))
                        Set NewPros = NewPro.Products
                    On Error GoTo 0
                    
                End If
                    
            End If
            
        Next j

        Set NewPros = RootPros
        
    Next i
    
    CATIA.RefreshDisplay = True
            
    MsgBox "完了しました。"

End Sub

簡単な実行確認はしていますが、エラーの発生や意図しない動きをする可能性があります。

 

コード解説

ここでは上記マクロコードのいくつかの部分を抜粋して解説していきます。
 

ドキュメントの定義

    If TypeName(CATIA.ActiveDocument) <> "PartDocument" Then
        MsgBox "プロダクトから生成されたCATPart専用マクロです。"
        Exit Sub
    End If
    
    Dim Doc As PartDocument
    Set Doc = CATIA.ActiveDocument
    
    Dim PT As Part
    Set PT = Doc.Part

まず、はじめにアクティブドキュメントの定義をします。
今回のマクロはCATPartでのみ有効なものなので、アクティブドキュメントがCATPart以外の場合はTypeName関数を使った条件分岐でマクロを終了するようにしています。

条件分岐の先、つまりはアクティブドキュメントがCATPartの場合は変数「Doc」にアクティブドキュメントを代入します。あわせて変数「PT」にはアクティブドキュメントのPartを代入します。
 

[プロダクトからCATPartを生成]で作成されたCATPartかを判定

    Dim NameCheck As Integer
    NameCheck = InStr(1, PT.Name, "_AllCATPart")

    If NameCheck = 0 Then
        MsgBox "プロダクトから生成されたCATPart専用マクロです。"
        Exit Sub
    End If

つぎにアクティブドキュメントが[プロダクトからCATPartを生成]で作成されたCATPartかを判定します。
ここではPartの名称に「_AllCATPart」の文字列が含めれている場合に[プロダクトからCATPartを生成]で作成されたCATPartであると判断します。

InStr関数を使うことで「指定した文字列A」に対して「指定した文字列B」が何番目の文字かを取得することができます。文字列が含まれない場合は「0」が返されるので、ここでは「NameCheck = 0」の場合にはマクロを中断するようにしています。
 

新規Productを作成

    Dim ExportPro As ProductDocument
    Set ExportPro = CATIA.Documents.Add("Product")

    Dim RootPro As Product
    Set RootPro = ExportPro.Product

    Dim RootPros As Products
    Set RootPros = RootPro.Products

    On Error Resume Next
        RootPro.PartNumber = Replace(PT.Name, "_AllCATPart", "")
    On Error GoTo 0

つぎに新規Productを作成します。(Productの作成方法は「Documentsコレクション」を参照) 

新規Productを作成したら、あわせて一番親のProduct(RootProductともいう)とそのProductsコレクションを定義しておきます。これらは以降で新規CATProduct/CATPartを作成していくときに使います。

作成したProductの名前は、CATPartの名称から「_All CATPart」を取り除いたものにします。
(Replace関数を使い「_All CATPart」という文字列を「」に変換すれば取り除くことが可能)

今回は、このReplaceでなぜかエラーが発生してしまったので「On Error Resume Next」で無視させています。(「On Error Resume Next」を消しても問題なく実行できる場合は「On Error〜」の2行は削除して問題ありません)
 

出力された形状セットとボディーをすべて取得

    Dim HBCount As Integer
    
    Dim SEL As Selection
    Set SEL = Doc.Selection
    
    SEL.Search ("ジェネレーティブ・シェイプ・デザイン.形状セット,all")
    
    Dim SELColl As Collection
    Set SELColl = New Collection
    
    HBCount = SEL.Count '形状セットの数を取得
    
    Dim i As Integer
    For i = 1 To SEL.Count
        SELColl.Add SEL.Item(i).Value
    Next i
    
    SEL.Clear
    SEL.Search ("パート・デザイン.ボディー,all")
    SEL.Remove 1 'パーツ・ボディーを選択から除去
    
    For i = 1 To SEL.Count
        SELColl.Add SEL.Item(i).Value
    Next i
    
    SEL.Clear

つぎにCATPart内の全ての形状セットとボディーを取得し、それぞれ同一のコレクション「SELColl」に格納しておきます。これにより「SELColl.Item(x)」で任意の形状セット/ボディーをいつでも取り出すことが可能になります。

ここでは①形状セット→②ボディーの順に「SELColl」に格納していくので
「SELColl.Item(1) 〜 SELColl.Item(HBCount)」の範囲が形状セット
「SELColl.Item(HBCount + 1) 〜 SELColl.Item(SELColl.Count)」の範囲がボディー
のように表すことができます。

以降ではこの「SELColl」に入っている1番目の形状セットから順に1つずつループで処理を行います。
 

ループで新規Productに出力

この部分の処理は1から説明すると非常に長くなるので、大まかな概要だけ説明していきます。

ここでは前項で取得した形状セットとボディーの名前を取得しProduct構成を再現していきます。

形状セット/ボディーの名前は
「Product2.1¥Product6.1¥Part6.1¥形状セット.1」
のように親のProductから順に「¥」マークで区切られてることがわかります。

この文字列を「Split関数」を使って「¥」マーク部分で分割します。
分割した文字列は「ProNameArray」という配列に格納します。
たとえば先ほどの文字列の場合は”Product2.1″、"Product6.1″、"Part6.1″、"形状セット.1″という4つの文字列が配列に格納されます。

あとはこの配列内の要素数だけループで処理を行っていきます。
ループ内では「Product」「Part」「形状セット/ボディー」の3つに分けて処理をします。
たとえば前と同じ文字列の場合はProduct2.1Product6.1が「ProductPart6.1が「Part形状セット.1が「形状セット/ボディーと振り分けることができます。

それぞれの処理の内容は以下のとおりです。

Product → その名前で新規Productを作成
Part → その名前で新規Partを作成
形状セット/ボディー → ベースのCATPartからコピペ

これを「ProNameArray」に入っている最初の要素から順に行なっていきます。
たとえばこれまでの文字列の場合「①Product2.1②Product6.1③Part6.1④形状セット.1」の順で処理を行なっていきます。よって以下のような処理が行われます。

① 「Product2.1」という名前のProductを作成
②  ①の直下に「Product6.1」という名前のProductを作成
③  ②の直下に「Part6.1」という名前のPartを作成
④  ③にベースのCATPartから該当の形状セット/ボディーをコピペ      

  
上記で基本的な部分の流れはできますが、同じProduct内に複数のProduct/Partがある場合は上記の処理ではできません。(上記の処理では毎回新規Productを作成するので、同名のProductが作成され別物扱いされてしまうため)

そこで、作成するProductと同じ名前のProductが既に存在する場合は、新規Productを作成せずにそのProductを再利用するような処理を行います。

そのために作成したProductの名前を全て「CreateProNameArray」という配列に格納していきます。これにより既にProductを作成しているか、作成していないのかを確認することができます。

 

まとめ

今回は「Productから作成したCATPartを元のProduct構成に戻すマクロ」についての内容でした。

簡単に処理の流れをまとめると以下の2ステップです。
① [プロダクトからCATPartを生成]で作成されたCATPart内の形状セット/ボディーを取得
② 形状セット/ボディーの名称から元のProduct構成通りにProductを新規で再構築していく

分岐が多く分かりづらいですが、基本的には上記の流れがうまくいくように分岐をさせているだけなので、処理の根本の目的が理解できれば後は自身の書き方で作成していけば良いと思います。

 

目次へ戻る
 

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

2024年8月26日CATIA,CATIAマクロ