ボディー名と形状セット名をCSVファイルそして出力するマクロ2｜CATIAマクロの作成方法

以前「ボディー名と形状セット名をCSVファイルそして出力するマクロ」のサンプルコードを紹介しましたが、お問い合わせ頂いた方から「ボディ名と形状セット名をツリー順に並べたい」とご連絡いただきました。

というわけで、以前のサンプルコードを少し書き換えて「ツリー第1階層にあるボディーと形状セットの名称をツリー順でCSVファイルに出力するマクロ」の紹介していきます。

基本的な処理内容は以前のものと変わっていないので、今回は追加した分のコードのみの解説をしていきます。全体の処理内容については前回記事を参考にして下さい。

Contents

1. マクロの機能
2. サンプルコード
3. コード解説
4. まとめ

マクロの機能

今回作成したのはツリー第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関数の処理内容は下記のとおりです。

① names()の要素数をobjsと同じ数にする
② objsコレクション内ループ
　 ③ PartオブジェクトのBodiesコレクション内のボディー名称と一致するか確認
　 ④ PartオブジェクトのHybridBodiesコレクション内の形状セット名称と一致するか確認　
　 ⑤ もし③と④のどちらかで一致した場合、names()に名称を格納
⑤ コレクション内のループが終わるまで②に戻る
⑥ names()のから要素部分を削除する
⑦ names()を返す

　
少し回りくどい処理をしていますが、ツリー第1階層のみを順番に並べるようにするにはこの関数のようにひと手間加える必要がありそうです。(VBAではボディーを扱うBodiesと形状セットを扱うHybridBodiesで別れているため、単純に取得はできなさそうです)