ボディー名と形状セット名をCSVファイルそして出力するマクロ2|CATIAマクロの作成方法
以前「ボディー名と形状セット名をCSVファイルそして出力するマクロ」のサンプルコードを紹介しましたが、お問い合わせ頂いた方から「ボディ名と形状セット名をツリー順に並べたい」とご連絡いただきました。
というわけで、以前のサンプルコードを少し書き換えて「ツリー第1階層にあるボディーと形状セットの名称をツリー順でCSVファイルに出力するマクロ」の紹介していきます。
基本的な処理内容は以前のものと変わっていないので、今回は追加した分のコードのみの解説をしていきます。全体の処理内容については前回記事を参考にして下さい。
マクロの機能
今回作成したのはツリー第1階層にあるボディー/形状セット名を“ツリー順で"CSV
・ファイル名はPart名 (※同名のファイルがある場合は上書きの確認をする)
・ボディー名称、形状セット名称の順で出力
・出力後はCSVファイルを開く
サンプルコード
マクロのコードは以下のとおりです。
コード内の保存場所となる「saveDir」の中身は自身のものに書き換える必要があります。
Option Explicit
Sub CATMain()
'アクティブドキュメント定義
If TypeName(CATIA.ActiveDocument) <> "PartDocument" Then
MsgBox "このマクロはPartDocument専用です。" & vbLf & _
"CATPartに切り替えて実行してください。"
Exit Sub
End If
Dim doc As PartDocument
Set doc = CATIA.ActiveDocument
'Part定義
Dim pt As Part
Set pt = doc.Part
'Selection定義
Dim sel As Selection
Set sel = doc.Selection
sel.Clear
'ドキュメント内の全てのボディー/形状セットを取得
Dim i As Integer
Dim objs As Collection
Set objs = New Collection
sel.Search ("(ジェネレーティブ・シェイプ・デザイン.形状セット + パート・デザイン.ボディー),all")
For i = 1 To sel.Count
objs.Add sel.Item(i).Value
Next i
sel.Clear
'ツリー第1階層のみの名称を取得
Dim names() As String 'ボディー/形状セット名格納用配列
names = Get1LvNames(objs) 'ツリー第1階層のボディー/形状セット名を取得
'csv出力用文字列の作成
Dim csv As String
csv = names(1)
For i = 2 To UBound(names)
csv = csv + "," + names(i) 'カンマ + ボディー/形状セット名を後ろに追加
Next i
'csv出力
Dim fs 'As FileSystem
Set fs = CATIA.FileSystem
Dim saveDir As String
saveDir = "C:\Users\ユーザー名\Desktop" '保存ディレクトリ(フォルダ)の指定
Dim fileName As String
fileName = pt.name + ".csv" '保存ファイル名の指定
Dim savePath As String
savePath = saveDir + "\" + fileName '"'
If fs.FileExists(savePath) Then
Dim res As Integer
res = MsgBox("同名のファイルが存在します。上書きしますか?", vbYesNo + vbQuestion)
If res = vbNo Then Exit Sub
End If
Dim csvFile As file
Set csvFile = fs.CreateFile(savePath, True)
Dim ts As TextStream
Set ts = csvFile.OpenAsTextStream("ForWriting")
ts.Write (csv)
ts.Close
Set fs = Nothing
Set ts = Nothing
'出力したcsvファイルを開く
Shell "C:\Windows\Explorer.exe " & savePath, vbNormalFocus
End Sub
'―――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
Function Get1LvNames(ByVal objs As Collection) As String()
Dim names() As String
ReDim names(objs.Count)
Dim pt As Part
Set pt = CATIA.ActiveDocument.Part
Dim obj As Object
Dim b As Body
Dim hb As HybridBody
Dim chk As Boolean
Dim i As Integer: i = 1
'objs内のツリー第1階層のボディー/形状セットの名称のみを取得
For Each obj In objs
chk = False
For Each b In pt.Bodies
If obj.name = b.name Then chk = True
Next b
For Each hb In pt.HybridBodies
If obj.name = hb.name Then chk = True
Next hb
If chk = True Then
names(i) = obj.name
i = i + 1
End If
Next obj
'空の要素を削除
For i = 1 To UBound(names)
If names(i) = "" Then
ReDim Preserve names(i - 1)
Exit For
End If
Next i
Get1LvNames = names()
End Function
コード解説
基本的には前回のサンプルコードと変わりありません。
今回は「Get1LvNames」という、入力されたボディーと形状セットの入ったコレクションから、ツリー第1階層のみを選別しその名称の入った配列を返す関数を作成しました。
以下では「Get1LvNames」の処理内容を解説していきます。
Get1LvNames関数
Function Get1LvNames(ByVal objs As Collection) As String()
Dim names() As String
ReDim names(objs.Count)
Dim pt As Part
Set pt = CATIA.ActiveDocument.Part
Dim obj As Object
Dim b As Body
Dim hb As HybridBody
Dim chk As Boolean
Dim i As Integer: i = 1
'objs内のツリー第1階層のボディー/形状セットの名称のみを取得
For Each obj In objs
chk = False
For Each b In pt.Bodies
If obj.name = b.name Then chk = True
Next b
For Each hb In pt.HybridBodies
If obj.name = hb.name Then chk = True
Next hb
If chk = True Then
names(i) = obj.name
i = i + 1
End If
Next obj
'空の要素を削除
For i = 1 To UBound(names)
If names(i) = "" Then
ReDim Preserve names(i - 1)
Exit For
End If
Next i
Get1LvNames = names()
End Function
引数はボディーと形状セットの入ったコレクションで、戻り値は名称(文字列)の入った配列です。
関数内では、入力されたコレクション内からツリー第1階層のもののみを選別し、名称を取得するという処理を行なっています。
まずはSelectionオブジェクトのSearchメソッドで「ボディーと形状セットを選択→コレクションに順に格納」という処理をします。(詳しくは選択しているオブジェクトを一時保管する方法を参照)
Searchメソッドを使うことで、ツリーの上から順にボディー/形状セットを取得することができます。
これらを格納したコレクションを引数としてGet1LvNames関数に入力します。
これはSearchメソッドだけでは第1階層のボディー/形状セットを取得することができないためです。
本コードではアクティブドキュメント内の全てのボディー/形状セットをコレクションに格納しています。これをGet1LvNames関数に入力することで、第1階層のボディー/形状セットを選別し名前を取得することが可能になります。
Get1LvNames関数の処理内容は下記のとおりです。
② objsコレクション内ループ
③ PartオブジェクトのBodiesコレクション内のボディー名称と一致するか確認
④ PartオブジェクトのHybridBodiesコレクション内の形状セット名称と一致するか確認
⑤ もし③と④のどちらかで一致した場合、names()に名称を格納
⑤ コレクション内のループが終わるまで②に戻る
⑥ names()のから要素部分を削除する
⑦ names()を返す
少し回りくどい処理をしていますが、ツリー第1階層のみを順番に並べるようにするにはこの関数のようにひと手間加える必要がありそうです。(VBAではボディーを扱うBodiesと形状セットを扱うHybridBodiesで別れているため、単純に取得はできなさそうです)
まとめ
今回はツリー第1階層にあるボディー/形状セット名をCSV
いろいろコードの説明をしてきましたが、今回の最重要点はツリー第1階層のボディーと形状セットをツリー順で取得するという部分です。SelectionオブジェクトのSearchメソッドではツリー順にオブジェクトを取得することができますが、ツリー第1階層のみという制限ができません。
そこで、ツリー順で取得できるSearchメソッドを使いオブジェクトを一旦取得、その後に不要なオブジェクトを調べて排除するという処理をしているだけです。
CSVに出力する方法としては前回と全く変わっていないので、オブジェクトの取得部分をうまく書き換えれば、今回のように自分の用途に合わせたオブジェクトのみをうまく出力することが可能になります。うまく自身の使用用途に合わせて書き換えてみてください。







