Productから作成したCATPartを元のProduct構成に戻すマクロ|CATIAマクロの作成方法
今回の記事は「マクロ案」よりいただいた内容です。
送って頂いた内容は以下のようなマクロです。
⑤プロダクトを履歴なしのプロダクトを作成
準備
「プロダクトからcatpartを生成」で出力したパートを作成
↓
マクロ実行&結果
用意したパートでボディや形状セット名の¥を利用してプロダクト 化へ
はじめに言っておくと今回のマクロでは完全に同じProduct構成を再現することはできません。
これは準備として生成するCATPartが「インスタンス名」で出力されることが深く関係してきます。
詳しくは本文で解説していきますが、この前提はあらかじめ理解しておいてください。
マクロの機能
今回作成したマクロは
『Productから作成したCATPartを元のProduct構成を再現するマクロ』です。
具体的な機能は以下のとおりです。
(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.1とProduct6.1が「Product」、Part6.1が「Part」、形状セット.1が「形状セット/ボディー」と振り分けることができます。
それぞれの処理の内容は以下のとおりです。
Product → その名前で新規Productを作成
Part → その名前で新規Partを作成
形状セット/ボディー → ベースのCATPartからコピペ
これを「ProNameArray」に入っている最初の要素から順に行なっていきます。
たとえばこれまでの文字列の場合「①Product2.1②Product6.1③Part6.1④形状セット.1」の順で処理を行なっていきます。よって以下のような処理が行われます。
② ①の直下に「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を新規で再構築していく
分岐が多く分かりづらいですが、基本的には上記の流れがうまくいくように分岐をさせているだけなので、処理の根本の目的が理解できれば後は自身の書き方で作成していけば良いと思います。







