Part内のボディーをIGES出力するマクロ｜CATIAマクロの作成方法

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

パーツボディー内でボディーや形状セットを分割し部品を組み上げています。
そこで、以下のようなことができないか考えています。

・1つのボディーだけを表示させ、IGESファイルで保存する

※IGES(拡張子.igs)：様々なCADソフトで利用可能な中間ファイル

基本的にはProduct内のCATPartをIGESファイルで出力するマクロと同じ考えです。
CATPart内出力では表示状態の形状をIGES出力することができるので、表示/非表示を切り替えて行くことで全てのボディーを1つずつ出力することが可能になります。

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

マクロの機能

今回作成したマクロはPart内のボディーを1つずつIGESファイルとして出力するマクロです。
画像には形状セットもありますが、本マクロはボディーのIGES出力のため完全に無視しています。

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

マクロの機能まとめ・アクティブドキュメント(CATPart)内のボディーをIGESファイルとして出力
・ファイル名は「Body-X.igs」 (※「X」は連番)
・ボディー内が空の場合も空のIGESファイルが出力される
・マクロ実行後にデスクトップに新規作成される「IGES書き出し日時」フォルダに出力
・出力後はフォルダを開く
　
※注意点
・「IGES書き出し日時」と同名のフォルダがデスクトップにある場合はマクロ中断
　(日時には現在の「年/月/日/時/分/秒」が入力されるため、同名フォルダは存在しないはず )

IGESファイルはもともと米国規格だったため、バージョンによっては日本語名をつけることができない場合があります。そのためサンプルコードでは「Body-X.igs」という名称をつけていますが、特に深い意味はないので任意で書き換えてください。

サンプルコード

マクロのコードは以下のとおりです。
マクロ実行後にCATPart内の全てのボディーをIGESファイルとして出力します。
実行後にマクロの操作をキャンセルしたい場合は[Esc]キーを押下してください。

※コピペで実行可能ですが、保存場所のパスだけは自身の環境に合わせて書き直す必要あり。

Option Explicit
Sub CATMain()

 'ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ定義
    If TypeName(CATIA.ActiveDocument) <> "PartDocument" Then
       MsgBox "このマクロはPartDocument専用です。" & vbLf & _
              "アセンブリーワークベンチに切り替えて実行してください。"
       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
    
 'VisPropertySet定義
    Dim vps As VisPropertySet
    Set vps = sel.VisProperties
    
    
  '*********************************************
  '　        書き出し用フォルダ作成
  '*********************************************
    Dim savePath As String                                                  '※保存場所のパスを入力
    savePath = "C:\Users\ﾕｰｻﾞｰ名\Desktop"                                    '　必ず自分の環境のものに書き換えて下さい
    
    Dim FoldName As String
    FoldName = "IGES書き出し " & Year(Date) & Month(Date) & Day(Date) & _
                Hour(Time) & Minute(Time) & Second(Time)                    '作成するフォルダ名を指定
    
    Dim FoldPath As String
    FoldPath = savePath & "\" & FoldName                                    '新規フォルダのパス"
    
    Dim FileSys 'As FileSystem
    Set FileSys = CATIA.FileSystem
    
    Dim FoldExi As Boolean
    FoldExi = FileSys.FolderExists(FoldPath)
    If FoldExi = True Then
        MsgBox "予期せぬエラーが発生しました。" & vbLf & _
               "再度マクロを実行し直してください。"
        Exit Sub
    End If
    
    Dim CreateFold As Folder
    Set CreateFold = FileSys.CreateFolder(FoldPath)
    
    
  '*********************************************
  '　     　　　　　   IGES出力
  '*********************************************
    CATIA.RefreshDisplay = False
    
    Dim b As Body
    For Each b In pt.Bodies
        sel.Add b                          '第1階層のﾎﾞﾃﾞｨｰをすべて選択
    Next
    
    Dim hb As HybridBody
    For Each hb In pt.HybridBodies
        sel.Add hb                         '第1階層の形状ｾｯﾄをすべて選択
    Next
    
    vps.SetShow catVisPropertyNoShowAttr    '選択状態のｵﾌﾞｼﾞｪｸﾄをすべて非表示
    sel.Clear
    
    Dim i As Integer:  i = 1
    For Each b In pt.Bodies
     'ﾎﾞﾃﾞｨｰを1つ表示
        sel.Add b
        vps.SetShow catVisPropertyShowAttr

     '出力ﾌｧｲﾙ名の指定(ﾊﾞｰｼﾞｮﾝによっては日本語の設定不可)
        Dim igsName As String
        igsName = "Body-" & i
        i = i + 1
        
     'IGES出力
        doc.ExportData FoldPath & "\" & igsName, "igs"　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　'"'
        
     '表示したﾎﾞﾃﾞｨｰを非表示
        sel.Add b
        vps.SetShow catVisPropertyNoShowAttr
        sel.Clear
    Next
    
    CATIA.RefreshDisplay = True
    
    Shell "C:\Windows\Explorer.exe " & FoldPath, vbNormalFocus

End Sub

Option Explicit

Sub CATMain()

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

If TypeName(CATIA.ActiveDocument) <> "PartDocument" Then

MsgBox "このマクロはPartDocument専用です。" & vbLf & _

"アセンブリーワークベンチに切り替えて実行してください。"

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

'VisPropertySet定義

Dim vps As VisPropertySet

Set vps = sel.VisProperties

'*********************************************

'　書き出し用フォルダ作成

'*********************************************

Dim savePath As String '※保存場所のパスを入力

savePath = "C:\Users\ﾕｰｻﾞｰ名\Desktop" '　必ず自分の環境のものに書き換えて下さい

Dim FoldName As String

FoldName = "IGES書き出し " & Year(Date) & Month(Date) & Day(Date) & _

Hour(Time) & Minute(Time) & Second(Time) '作成するフォルダ名を指定

Dim FoldPath As String

FoldPath = savePath & "\" & FoldName '新規フォルダのパス"

Dim FileSys 'As FileSystem

Set FileSys = CATIA.FileSystem

Dim FoldExi As Boolean

FoldExi = FileSys.FolderExists(FoldPath)

If FoldExi = True Then

MsgBox "予期せぬエラーが発生しました。" & vbLf & _

"再度マクロを実行し直してください。"

Exit Sub

End If

Dim CreateFold As Folder

Set CreateFold = FileSys.CreateFolder(FoldPath)

'*********************************************

'　　　　　　 IGES出力

'*********************************************

CATIA.RefreshDisplay = False

Dim b As Body

For Each b In pt.Bodies

sel.Add b '第1階層のﾎﾞﾃﾞｨｰをすべて選択

Dim hb As HybridBody

For Each hb In pt.HybridBodies

sel.Add hb '第1階層の形状ｾｯﾄをすべて選択

vps.SetShow catVisPropertyNoShowAttr '選択状態のｵﾌﾞｼﾞｪｸﾄをすべて非表示

sel.Clear

Dim i As Integer: i = 1

For Each b In pt.Bodies

'ﾎﾞﾃﾞｨｰを1つ表示

sel.Add b

vps.SetShow catVisPropertyShowAttr

'出力ﾌｧｲﾙ名の指定(ﾊﾞｰｼﾞｮﾝによっては日本語の設定不可)

Dim igsName As String

igsName = "Body-" & i

i = i + 1

'IGES出力

doc.ExportData FoldPath & "\" & igsName, "igs"　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　'"'

'表示したﾎﾞﾃﾞｨｰを非表示

sel.Add b

vps.SetShow catVisPropertyNoShowAttr

sel.Clear

CATIA.RefreshDisplay = True

Shell "C:\Windows\Explorer.exe " & FoldPath, vbNormalFocus

End Sub

コード解説

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

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

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」にアクティブドキュメントを代入します。

アクティブドキュメント(CATPart)が定義できたら、あわせてPartオブジェクトを定義します。
　

Selection/VisPropertySet定義

 'Selection定義
    Dim sel As Selection
    Set sel = doc.Selection
    sel.Clear
    
 'VisPropertySet定義
    Dim vps As VisPropertySet
    Set vps = sel.VisProperties

'Selection定義

Dim sel As Selection

Set sel = doc.Selection

sel.Clear

'VisPropertySet定義

Dim vps As VisPropertySet

Set vps = sel.VisProperties

次にSelectionオブジェクトとVisPropertySetオブジェクトを定義します。
この2つのオブジェクトを使ってPart内のボディーの表示状態を切り替えることが可能になります。
　

書き出し用フォルダ作成

  '*********************************************
  '　        書き出し用フォルダ作成
  '*********************************************
    Dim savePath As String                                                  '※保存場所のパスを入力
    savePath = "C:\Users\ﾕｰｻﾞｰ名\Desktop"                                    '　必ず自分の環境のものに書き換えて下さい
    
    Dim FoldName As String
    FoldName = "IGES書き出し " & Year(Date) & Month(Date) & Day(Date) & _
                Hour(Time) & Minute(Time) & Second(Time)                    '作成するフォルダ名を指定
    
    Dim FoldPath As String
    FoldPath = savePath & "\" & FoldName                                    '新規フォルダのパス"
    
    Dim FileSys 'As FileSystem
    Set FileSys = CATIA.FileSystem
    
    Dim FoldExi As Boolean
    FoldExi = FileSys.FolderExists(FoldPath)
    If FoldExi = True Then
        MsgBox "予期せぬエラーが発生しました。" & vbLf & _
               "再度マクロを実行し直してください。"
        Exit Sub
    End If
    
    Dim CreateFold As Folder
    Set CreateFold = FileSys.CreateFolder(FoldPath)

'*********************************************

'　書き出し用フォルダ作成

'*********************************************

Dim savePath As String '※保存場所のパスを入力

savePath = "C:\Users\ﾕｰｻﾞｰ名\Desktop" '　必ず自分の環境のものに書き換えて下さい

Dim FoldName As String

FoldName = "IGES書き出し " & Year(Date) & Month(Date) & Day(Date) & _

Hour(Time) & Minute(Time) & Second(Time) '作成するフォルダ名を指定

Dim FoldPath As String

FoldPath = savePath & "\" & FoldName '新規フォルダのパス"

Dim FileSys 'As FileSystem

Set FileSys = CATIA.FileSystem

Dim FoldExi As Boolean

FoldExi = FileSys.FolderExists(FoldPath)

If FoldExi = True Then

MsgBox "予期せぬエラーが発生しました。" & vbLf & _

"再度マクロを実行し直してください。"

Exit Sub

End If

Dim CreateFold As Folder

Set CreateFold = FileSys.CreateFolder(FoldPath)

IGESファイルを出力するためのフォルダを作成します。

まずは保存場所のパスを取得します。
上記のコードでは保存場所を「SavePath = “C:\Users\ユーザー名\Desktop”」
つまりはデスクトップとしています。
※再三の注意となりますがここのパスはご自身のPCのパスに書き換えて下さい。
　多くの場合、「ユーザー名」の部分を自分のものにすれば問題ないと思います。

次に、作成するフォルダの名称を指定します。
上記コードでは「IGES書き出し日時」というフォルダ名で作成しています。
(日時には現状の日時の年から秒までを取得し、その数字の羅列を入力しています。
たとえば2020年1月2日3時4分56秒の場合、「20200102030456」と入力されます。)

このようにフォルダ名を時間によって変更させることで
デスクトップ上に同じフォルダが存在しないようにしています。

ただ必ずしも存在しないとは言えないので
万が一同じフォルダが存在した場合にはマクロを終了するようにしています。
フォルダの存在を確認するには「FileSystemオブジェクト」の「FolderExistsメソッド」を使います。

最後に、これまでに決めた「保存場所」と「フォルダ名」を組み合わせてフォルダを新規作成します。
フォルダの作成は「FileSystemオブジェクト」の「CreateFolderメソッド」を使って行います。
　

IGES出力

 '*********************************************
  '　     　　　　　   IGES出力
  '*********************************************
    CATIA.RefreshDisplay = False
    
    Dim b As Body
    For Each b In pt.Bodies
        sel.Add b                          '第1階層のﾎﾞﾃﾞｨｰをすべて選択
    Next
    
    Dim hb As HybridBody
    For Each hb In pt.HybridBodies
        sel.Add hb                         '第1階層の形状ｾｯﾄをすべて選択
    Next
    
    vps.SetShow catVisPropertyNoShowAttr    '選択状態のｵﾌﾞｼﾞｪｸﾄをすべて非表示
    sel.Clear
    
    Dim i As Integer:  i = 1
    For Each b In pt.Bodies
     'ﾎﾞﾃﾞｨｰを1つ表示
        sel.Add b
        vps.SetShow catVisPropertyShowAttr

     '出力ﾌｧｲﾙ名の指定(ﾊﾞｰｼﾞｮﾝによっては日本語の設定不可)
        Dim igsName As String
        igsName = "Body-" & i
        i = i + 1
        
     'IGES出力
        doc.ExportData FoldPath & "\" & igsName, "igs"　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　'"'
        
     '表示したﾎﾞﾃﾞｨｰを非表示
        sel.Add b
        vps.SetShow catVisPropertyNoShowAttr
        sel.Clear
    Next
    
    CATIA.RefreshDisplay = True

'*********************************************

'　　　　　　 IGES出力

'*********************************************

CATIA.RefreshDisplay = False

Dim b As Body

For Each b In pt.Bodies

sel.Add b '第1階層のﾎﾞﾃﾞｨｰをすべて選択

Dim hb As HybridBody

For Each hb In pt.HybridBodies

sel.Add hb '第1階層の形状ｾｯﾄをすべて選択

vps.SetShow catVisPropertyNoShowAttr '選択状態のｵﾌﾞｼﾞｪｸﾄをすべて非表示

sel.Clear

Dim i As Integer: i = 1

For Each b In pt.Bodies

'ﾎﾞﾃﾞｨｰを1つ表示

sel.Add b

vps.SetShow catVisPropertyShowAttr

'出力ﾌｧｲﾙ名の指定(ﾊﾞｰｼﾞｮﾝによっては日本語の設定不可)

Dim igsName As String

igsName = "Body-" & i

i = i + 1

'IGES出力

doc.ExportData FoldPath & "\" & igsName, "igs"　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　'"'

'表示したﾎﾞﾃﾞｨｰを非表示

sel.Add b

vps.SetShow catVisPropertyNoShowAttr

sel.Clear

CATIA.RefreshDisplay = True

今回のマクロのメインの部分の処理「IGES出力」をしていきます。

処理内容としては以下の内容を全てのボディーに対して繰り返しているだけです。

① ツリー第1階層にある全てのボディーと形状セットを非表示　　　　
② ボディーを1つだけ表示
③ IGES出力

　
任意のドキュメントを別ファイルとして書き出すには
「Documentオブジェクト」の「ExportDataメソッド」を使います。

ExportDataメソッド

Documentオブジェクト.ExportData パス,“拡張子“

この構文によりDocumentオブジェクトを指定した拡張子で書き出すことができます。
パスには出力先のパス(ファイル名も含む)を入力、
拡張子には出力するファイルの拡張子を入力します。

コードのはじめにある「CATIA.RefreshDisplay=False」は画面の更新を無効にする処理です。これを行うことで多少ではありますが処理速度が速くなります。最後に「CATIA.RefreshDisplay=True」で元の状態に戻しています。
　

出力フォルダを表示

Shell "C:\Windows\Explorer.exe " & FoldPath, vbNormalFocus

1	Shell "C:\Windows\Explorer.exe " & FoldPath, vbNormalFocus

最後にデスクトップに作成したフォルダを「Shell関数」を使って開きます。
Shell関数についてはExcelマクロでもよく使われ、多くの解説ページがあるためここでは割愛します。

まとめ

今回はCATPart内のボディーをIGESファイルとして出力するマクロについての内容でした。

このマクロの重要な部分は「ExportDataメソッド」による別ファイル出力と、表示状態を切り替えるためのSelectionオブジェクトとVisPropertySetオブジェクトの2つのオブジェクトです。

これらを使うことでIGES以外のファイル出力も可能になるはずなのでいろいろ試してみてください。
　

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

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

Vb Scripting for Catia V5: How to Program Catia Macros

created by Rinker

CATIA V5: Macro Programming with Visual Basic Script

created by Rinker

McGraw-Hill Education

2021年2月23日2024年8月26日CATIA, CATIAマクロ

Posted by Lic