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

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

題名:
ボディ名形状セット名のcsv書き出し
　
マクロ案:
パートデザインで、一次レベルのボディ名と形状セット名をCSVファイルに書き出したいです。

CSVファイルに書き出す方法はExcel VBAでもいくつか紹介されていますが、ここではCATIA VBAの「FileSytemオブジェクト」を使ってCSVファイルとして出力していきます。
サンプルコード内にも出てくる処理である”ファイルの作成や存在確認などの方法については「FileSytemオブジェクトページ」で解説しているので、詳しくはそちらを確認してください。

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

    
    Dim bName()     'ﾎﾞﾃﾞｨｰ名格納用配列
    Dim hbName()    '形状ｾｯﾄ名格納用配列

    ReDim bName(pt.Bodies.Count)
    ReDim hbName(pt.HybridBodies.Count)
    
    Dim i As Integer
    
 'ﾎﾞﾃﾞｨｰ名取得
    Dim b As Body
    For i = 1 To UBound(bName)
        Set b = pt.Bodies.Item(i)
        bName(i) = b.Name
    Next
    
 '形状ｾｯﾄ名取得
    Dim hb As HybridBody
    For i = 1 To UBound(hbName)
        Set hb = pt.HybridBodies.Item(i)
        hbName(i) = hb.Name
    Next
    
 'csv出力用文字列の作成
    Dim csv As String
    csv = bName(1)
    
    For i = 2 To UBound(bName)
        csv = csv + "," + bName(i)      'ｶﾝﾏ + ﾎﾞﾃﾞｨｰ名を後ろに追加
    Next i
    
    For i = 1 To UBound(hbName)
        csv = csv + "," + hbName(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

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

Dim bName() 'ﾎﾞﾃﾞｨｰ名格納用配列

Dim hbName() '形状ｾｯﾄ名格納用配列

ReDim bName(pt.Bodies.Count)

ReDim hbName(pt.HybridBodies.Count)

Dim i As Integer

'ﾎﾞﾃﾞｨｰ名取得

Dim b As Body

For i = 1 To UBound(bName)

Set b = pt.Bodies.Item(i)

bName(i) = b.Name

'形状ｾｯﾄ名取得

Dim hb As HybridBody

For i = 1 To UBound(hbName)

Set hb = pt.HybridBodies.Item(i)

hbName(i) = hb.Name

'csv出力用文字列の作成

Dim csv As String

csv = bName(1)

For i = 2 To UBound(bName)

csv = csv + "," + bName(i) 'ｶﾝﾏ + ﾎﾞﾃﾞｨｰ名を後ろに追加

Next i

For i = 1 To UBound(hbName)

csv = csv + "," + hbName(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

コード解説

ドキュメント/パーツの定義

 'ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ定義
    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

'ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ定義

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

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

つまり、アクティブドキュメントがCATPartの場合のみ変数「doc」にアクティブドキュメントを代入し、マクロの処理を続けます。

アクティブドキュメントが定義できたらあわせてPartオブジェクトも定義します。
(Partオブジェクトとは仕様ツリーの1番上にある「Part1」のこと)
　　

名称格納用配列の用意

    Dim bName()     'ﾎﾞﾃﾞｨｰ名格納用配列
    Dim hbName()    '形状ｾｯﾄ名格納用配列

    ReDim bName(pt.Bodies.Count)
    ReDim hbName(pt.HybridBodies.Count)

Dim bName() 'ﾎﾞﾃﾞｨｰ名格納用配列

Dim hbName() '形状ｾｯﾄ名格納用配列

ReDim bName(pt.Bodies.Count)

ReDim hbName(pt.HybridBodies.Count)

つぎにボディーと形状セットの名称を格納しておくための配列を用意します。
配列の要素数はPartオブジェクト(pt)の「Bodies」「HybridBodies」の数だけそれぞれ用意します。

ﾎﾞﾃﾞｨｰ名/形状ｾｯﾄ名取得

   Dim i As Integer
    
 'ﾎﾞﾃﾞｨｰ名取得
    Dim b As Body
    For i = 1 To UBound(bName)
        Set b = pt.Bodies.Item(i)
        bName(i) = b.Name
    Next
    
 '形状ｾｯﾄ名取得
    Dim hb As HybridBody
    For i = 1 To UBound(hbName)
        Set hb = pt.HybridBodies.Item(i)
        hbName(i) = hb.Name
    Next

Dim i As Integer

'ﾎﾞﾃﾞｨｰ名取得

Dim b As Body

For i = 1 To UBound(bName)

Set b = pt.Bodies.Item(i)

bName(i) = b.Name

'形状ｾｯﾄ名取得

Dim hb As HybridBody

For i = 1 To UBound(hbName)

Set hb = pt.HybridBodies.Item(i)

hbName(i) = hb.Name

ボディーと形状セットの数だけ別々にループ処理をさせて、全てのボディー/形状セットの名称を先ほど用意した配列に格納します。
　

csv出力用文字列の作成

 'csv出力用文字列の作成
    Dim csv As String
    csv = bName(1)
    
    For i = 2 To UBound(bName)
        csv = csv + "," + bName(i)      'ｶﾝﾏ + ﾎﾞﾃﾞｨｰ名を後ろに追加
    Next i
    
    For i = 1 To UBound(hbName)
        csv = csv + "," + hbName(i)     'ｶﾝﾏ + 形状ｾｯﾄ名を後ろに追加
    Next i

'csv出力用文字列の作成

Dim csv As String

csv = bName(1)

For i = 2 To UBound(bName)

csv = csv + "," + bName(i) 'ｶﾝﾏ + ﾎﾞﾃﾞｨｰ名を後ろに追加

Next i

For i = 1 To UBound(hbName)

csv = csv + "," + hbName(i) 'ｶﾝﾏ + 形状ｾｯﾄ名を後ろに追加

Next i

出力するcsvファイルの中身となるカンマ[,]で区切られた文字列を作成します。

初めに「csv」という変数に、bName内にある1番目の文字列(ボディーの名称)を入れます。
その後、ループ文を使いbName、hbNameの数だけ「, 名称」をcsvの後ろに追加していきます。

これにより「名称,名称,名称・・・,名称」というカンマ[,]で区切られた１行のテキストが完成します。
　

csv出力

'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出力

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

次に「FileSytemオブジェクト」を使って先ほど作成した文字列をcsvファイルとして出力します。

「saveDir」「fileName」では「保存場所」「ファイル名」を指定し、
この２つを合体させ出力するファイルのパスとなる「savePath」を作ります。

このとき「savePath」に該当するファイルが存在した場合は、上書きするかしないかのメッセージが表示するようになっています。ファイルの存在を確認するには「FileSytemオブジェクト」の「FileExistsメソッド」を使います。

次に同オブジェクトの「CreateFileメソッド」を使い、csvファイルを作成します。
ただ、この時点では何も書かれていないただの空データです。

そこで「TextStreamオブジェクト」の「Writeメソッド」を使って、先ほど作成したカンマ区切りの文字列を空データに書き込みます。

ファイルに書き出し

Dim ts As TextStream
Set ts = csvFile.OpenAsTextStream(“ForWriting”)
ts.Write (csv)
ts.Close

「TextStreamオブジェクト」を定義する際は上記の通り「FileSytemオブジェクト」の「OpenAsTextStreamメソッド」を使い、引数として「ForWriting」という文字列を渡します。
これにより定義した「TextStreamオブジェクト」(ts)を使っての値の書き出しが可能になります。

また、出力後は同オブジェクトの「Closeメソッド」で”ファイルを閉じる”という処理も必要になるので注意しましょう。
　

出力フォルダを表示

 '出力したcsvファイルを開く
    Shell "C:\Windows\Explorer.exe " & savePath, vbNormalFocus

1 2	'出力したcsvファイルを開く Shell "C:\Windows\Explorer.exe " & savePath, vbNormalFocus

最後に出力したcsvファイルを「Shell関数」を使って開きます。
Shell関数についてはExcelマクロでもよく使われ、多くの解説ページがあるためここでは割愛します。

まとめ

今回はツリー第1階層にあるボディー/形状セット名をCSVファイル出力するマクロについてでした。

大まかな流れとしては以下のような処理を行なっているだけです。

① ツリー第1階層にあるボディー/形状セット名をすべて配列内に格納　
② 配列内に入っている名前とカンマ[,]を使って1つのテキストを作成　
③ 空のcsvファイルを作成
④ 空のcsvファイルにテキストを書き出す。

基本的にCATIA VBAでフォルダ作成やファイル作成をする場合は、今回のように「FileSytemオブジェクト」を使います。Excel VBAの場合も同じような「FileSystemObjectオブジェクト(リンク先はMicrsoftページ)」というものを使ってファイル作成をします。

Excel VBAでよく使われる「FileSystemObjectオブジェクト」はCATIA VBAでも使うことができるので自身がやりやすい方を使うといいと思います。

サンプルマクロ集に戻る
 目次へ戻る