指定したフォルダ内のすべてのCATDrawingをDXF/PDFファイルで出力｜CATIAマクロの作成方法

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

ワークベンチ: CATDrawing

マクロ案:
目的：たくさんの.CATDrawingファイルがあり、それぞれをDXFとして書き出したい
　↓
・「CATDrawingをDXF/PDFファイルで出力｜CATIAマクロの作成方法」で作成できるのでは？
https://liclog.net/export-dxf-pdf-macro-vba-catia-v5/
　↓
・上記の方法だと1つのアクティブシートしか認識しない

「CATDrawingをDXF/PDFファイルで出力」ページでDXF化する方法を紹介していますが、このマクロは現在開いているアクティブなCATDrawingのみをDXF/PDF化するものとなっています。

そこで今回はお問い合わせいただいた内容のとおり、アクティブドキュメントだけでなく指定したフォルダ内にあるすべてのCATDrawingをDXF/PDFで出力するマクロを紹介していきます。基本的な処理は「CATDrawingをDXF/PDFファイルで出力」ページのマクロと同じですが、ファイル/フォルダ操作の処理が追加されていくイメージです、

※本マクロはDXF/PDFの両方に対応させていますが、片方が不要な場合はコード解説を参考に該当処理をコメントアウトしてください。

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

マクロの機能

今回作成したマクロは指定したフォルダ内のすべてのCATDrawingをDXF/PDFファイルで出力するマクロです。選択したフォルダ内にCATDrawing以外のものがあっても実行できるようになっています。具体的な機能は以下のとおりです。

マクロの機能まとめ・指定したフォルダ内のすべてのCATDrawingをDXF/PDFファイルで出力
・DXF/PDFは指定したフォルダ内に新規フォルダを作成してそこに出力する
・出力するファイル名称は「ドキュメント名(.dfx/.pdf)」
　複数シートがある場合は「ドキュメント名_シート名(.dfx/.pdf)」
・出力後はフォルダを開く

サンプルコード

マクロのサンプルコードは以下のとおりです。
フォルダ選択時の「ルートディレクトリとなるパスである「ROOT_FOLDER_PATH」の中身を自身の環境に書き換えないとエラーが発生するので注意してください。
※今回のマクロはファイルを1つも開いていなくてもCATIAさえ開いていれば実行できます。

Option Explicit

Const ROOT_FOLDER_PATH = "C:\Users\ﾕｰｻﾞｰ名\Desktop"  'ﾌｫﾙﾀﾞ選択時のﾙｰﾄﾃﾞｨﾚｸﾄﾘﾊﾟｽ
Const NEW_FOLDER_NAME = "DXF&PDF"                   '出力用新規ﾌｫﾙﾀﾞ名称

Sub CATMain()

    
 'ﾕｰｻﾞｰ選択でﾌｫﾙﾀﾞﾊﾟｽを取得
    Dim so, fso, obj_fold
    
    Set so = CreateObject("Shell.Application")
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set obj_fold = so.BrowseForFolder(0, "フォルダを選択してください", &H1 + &H10 + &H200, ROOT_FOLDER_PATH)
    If obj_fold Is Nothing Then Exit Sub
    
    Dim fold_path As String
    fold_path = obj_fold.Self.path
    
    
 'CATDrawingﾌｧｲﾙがあるか確認
    Dim fs, f, cnt
    Set fs = fso.GetFolder(fold_path).files
    For Each f In fs
        If InStr(f.Name, ".CATDrawing") <> 0 Then
            Exit For
        End If
        cnt = cnt + 1
    Next f
    If cnt = fs.Count Then
        MsgBox "選択したフォルダにCATDrawingが存在しません。"
        Exit Sub
    End If


 '出力用新規ﾌｫﾙﾀﾞ作成
    Dim new_fold_path As String
    new_fold_path = fold_path & "\" & NEW_FOLDER_NAME　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　             　                          '"
    
    Dim fold_exi As Boolean
    fold_exi = fso.FolderExists(new_fold_path)
    If fold_exi = True Then
        MsgBox "すでに「" & NEW_FOLDER_NAME & "」フォルダが存在します。" & vbLf & _
               "削除もしくは移動して再度マクロを実行し直してください。"
        Exit Sub
    End If
 
    Dim new_fold 'As Folder
    Set new_fold = fso.CreateFolder(new_fold_path)
    
    
 'ﾌｫﾙﾀﾞ内ﾙｰﾌﾟでDXF/PDF出力
    For Each f In fs
        
        If InStr(f.Name, ".CATDrawing") <> 0 Then
            
         'ﾄﾞｷｭﾒﾝﾄ(CATDrawing)を開く
            Dim doc As DrawingDocument
            Set doc = CATIA.Documents.Open(fold_path & "\" & f.Name)                                            '"
            
         'ﾌｧｲﾙ名(ﾊﾟｽ)作成
            Dim FileName As String
            FileName = new_fold_path & "\" & Replace(doc.Name, ".CATDrawing", "")                                '"
         
         '図面出力
            Call doc.ExportData(FileName, "dxf")    'dxfで出力
            Call doc.ExportData(FileName, "pdf")    'pdfで出力
        
         'ﾄﾞｷｭﾒﾝﾄ(CATDrawing)を閉じる
            doc.Close
            
        End If
    Next f
     
     
 '出力先ﾌｫﾙﾀﾞを開く
    Shell "C:\Windows\Explorer.exe " & new_fold_path, vbNormalFocus


End Sub

Option Explicit

Const ROOT_FOLDER_PATH = "C:\Users\ﾕｰｻﾞｰ名\Desktop" 'ﾌｫﾙﾀﾞ選択時のﾙｰﾄﾃﾞｨﾚｸﾄﾘﾊﾟｽ

Const NEW_FOLDER_NAME = "DXF&PDF" '出力用新規ﾌｫﾙﾀﾞ名称

Sub CATMain()

'ﾕｰｻﾞｰ選択でﾌｫﾙﾀﾞﾊﾟｽを取得

Dim so, fso, obj_fold

Set so = CreateObject("Shell.Application")

Set fso = CreateObject("Scripting.FileSystemObject")

Set obj_fold = so.BrowseForFolder(0, "フォルダを選択してください", &H1 + &H10 + &H200, ROOT_FOLDER_PATH)

If obj_fold Is Nothing Then Exit Sub

Dim fold_path As String

fold_path = obj_fold.Self.path

'CATDrawingﾌｧｲﾙがあるか確認

Dim fs, f, cnt

Set fs = fso.GetFolder(fold_path).files

For Each f In fs

If InStr(f.Name, ".CATDrawing") <> 0 Then

Exit For

End If

cnt = cnt + 1

Next f

If cnt = fs.Count Then

MsgBox "選択したフォルダにCATDrawingが存在しません。"

Exit Sub

End If

'出力用新規ﾌｫﾙﾀﾞ作成

Dim new_fold_path As String

new_fold_path = fold_path & "\" & NEW_FOLDER_NAME　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 '"

Dim fold_exi As Boolean

fold_exi = fso.FolderExists(new_fold_path)

If fold_exi = True Then

MsgBox "すでに「" & NEW_FOLDER_NAME & "」フォルダが存在します。" & vbLf & _

"削除もしくは移動して再度マクロを実行し直してください。"

Exit Sub

End If

Dim new_fold 'As Folder

Set new_fold = fso.CreateFolder(new_fold_path)

'ﾌｫﾙﾀﾞ内ﾙｰﾌﾟでDXF/PDF出力

For Each f In fs

If InStr(f.Name, ".CATDrawing") <> 0 Then

'ﾄﾞｷｭﾒﾝﾄ(CATDrawing)を開く

Dim doc As DrawingDocument

Set doc = CATIA.Documents.Open(fold_path & "\" & f.Name) '"

'ﾌｧｲﾙ名(ﾊﾟｽ)作成

Dim FileName As String

FileName = new_fold_path & "\" & Replace(doc.Name, ".CATDrawing", "") '"

'図面出力

Call doc.ExportData(FileName, "dxf") 'dxfで出力

Call doc.ExportData(FileName, "pdf") 'pdfで出力

'ﾄﾞｷｭﾒﾝﾄ(CATDrawing)を閉じる

doc.Close

End If

Next f

'出力先ﾌｫﾙﾀﾞを開く

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

End Sub

コード解説

定数の定義

'定数の定義
Const ROOT_FOLDER_PATH = "C:\Users\ﾕｰｻﾞｰ名\Desktop"  'ﾌｫﾙﾀﾞ選択時のﾙｰﾄﾃﾞｨﾚｸﾄﾘﾊﾟｽ
Const NEW_FOLDER_NAME = "DXF&PDF"                   '出力用新規ﾌｫﾙﾀﾞ名称

'定数の定義

Const ROOT_FOLDER_PATH = "C:\Users\ﾕｰｻﾞｰ名\Desktop" 'ﾌｫﾙﾀﾞ選択時のﾙｰﾄﾃﾞｨﾚｸﾄﾘﾊﾟｽ

Const NEW_FOLDER_NAME = "DXF&PDF" '出力用新規ﾌｫﾙﾀﾞ名称

「フォルダ選択時のルートディレクトリのパス」と「出力時の新規フォルダ名称」を指定します。

「フォルダ選択時のルートディレクトリのパス」はマクロ実行後に表示する、フォルダ選択のウィンドウ上で一番親となるディレクトリのパスです。たとえば「”C:\Users\liclog”」とした場合、マクロ実行で表示されるフォルダ選択ウィンドウは下画像のようになります。

扱うフォルダが深い階層にある場合、マクロ実行毎に階層を下りていくのは面倒なので扱いやすくなるディレクトリのパスを指定しておきましょう。

「出力時の新規フォルダ名称」はDXF/PDF出力する際に新規作成されるフォルダの名称です。
任意で名称を書き換えてください。

　
ﾕｰｻﾞｰ選択でﾌｫﾙﾀﾞﾊﾟｽを取得

 'ﾕｰｻﾞｰ選択でﾌｫﾙﾀﾞﾊﾟｽを取得
    Dim so, fso, obj_fold
    
    Set so = CreateObject("Shell.Application")
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set obj_fold = so.BrowseForFolder(0, "フォルダを選択してください", &H1 + &H10 + &H200, ROOT_FOLDER_PATH)
    If obj_fold Is Nothing Then Exit Sub
    
    Dim fold_path As String
    fold_path = obj_fold.Self.path

'ﾕｰｻﾞｰ選択でﾌｫﾙﾀﾞﾊﾟｽを取得

Dim so, fso, obj_fold

Set so = CreateObject("Shell.Application")

Set fso = CreateObject("Scripting.FileSystemObject")

Set obj_fold = so.BrowseForFolder(0, "フォルダを選択してください", &H1 + &H10 + &H200, ROOT_FOLDER_PATH)

If obj_fold Is Nothing Then Exit Sub

Dim fold_path As String

fold_path = obj_fold.Self.path

まずはユーザー選択により出力するCATDrawingがまとまったフォルダのパスを取得します。
ユーザーが選択したフォルダのパスを取得する方法としてShellオブジェクトの「BrowseForFolderメソッド」を使用します。

そのため、まずは「CreateObject関数」を使って「Shellオブジェクト」を取得します。
また以降で使用する「FileSystemObject」もここで合わせて取得しておきます。
※FileSystemObjectはCATIA VBAの「FileSystemオブジェクト」を使っても問題ありません。
　その場合は「Set fso = CATIA.FileSystem」として取得します。

Shellオブジェクトが取得出来たら「BrowseForFolderメソッド」でユーザー選択のフェーズを用意します。(BrowseForFolderメソッドの使い方は検索すれば出てくるのでそれらを参照ください)

ユーザー選択で取得したフォルダは「obj_fold.Self.path」と書くことでパスとして取得できます。

　
CATDrawingﾌｧｲﾙがあるか確認

 'CATDrawingﾌｧｲﾙがあるか確認
    Dim fs, f, cnt
    Set fs = fso.GetFolder(fold_path).files
    For Each f In fs
        If InStr(f.Name, ".CATDrawing") <> 0 Then
            Exit For
        End If
        cnt = cnt + 1
    Next f
    If cnt = fs.Count Then
        MsgBox "選択したフォルダにCATDrawingが存在しません。"
        Exit Sub
    End If

'CATDrawingﾌｧｲﾙがあるか確認

Dim fs, f, cnt

Set fs = fso.GetFolder(fold_path).files

For Each f In fs

If InStr(f.Name, ".CATDrawing") <> 0 Then

Exit For

End If

cnt = cnt + 1

Next f

If cnt = fs.Count Then

MsgBox "選択したフォルダにCATDrawingが存在しません。"

Exit Sub

End If

次にユーザーが選択したフォルダ内にCATDrawingファイルがあるかを確認します。
先ほど取得した「FileSystemオブジェクト」の「GetFolderメソッド」を使ってフォルダの取得し、フォルダ内ループでCATDrawingファイルが存在しているかを網羅的に確認します。

フォルダ内ループは、フォルダ取得後に下記のように書けば行えます。
フォルダ(fs) 内にあるファイル(f) がループ毎に順に切り替わっていきます。

フォルダ内ループ

For Each f In fs
‘ f (ﾌｧｲﾙ)を使った処理

Next f

今回のコードでは拡張子である「”.CATDrawing”」が名称に含まれているかを確認しています。
ループ終了後に1つもCATDrawingファイルがない場合はマクロを中断させる処理にしています。

　
出力用新規ﾌｫﾙﾀﾞ作成

 '出力用新規ﾌｫﾙﾀﾞ作成
    Dim new_fold_path As String
    new_fold_path = fold_path & "\" & NEW_FOLDER_NAME　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　                           　'"
    
    Dim fold_exi As Boolean
    fold_exi = fso.FolderExists(new_fold_path)
    If fold_exi = True Then
        MsgBox "すでに「" & NEW_FOLDER_NAME & "」フォルダが存在します。" & vbLf & _
               "削除もしくは移動して再度マクロを実行し直してください。"
        Exit Sub
    End If
 
    Dim new_fold 'As Folder
    Set new_fold = fso.CreateFolder(new_fold_path)

'出力用新規ﾌｫﾙﾀﾞ作成

Dim new_fold_path As String

new_fold_path = fold_path & "\" & NEW_FOLDER_NAME　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　'"

Dim fold_exi As Boolean

fold_exi = fso.FolderExists(new_fold_path)

If fold_exi = True Then

MsgBox "すでに「" & NEW_FOLDER_NAME & "」フォルダが存在します。" & vbLf & _

"削除もしくは移動して再度マクロを実行し直してください。"

Exit Sub

End If

Dim new_fold 'As Folder

Set new_fold = fso.CreateFolder(new_fold_path)

つぎにDXF/PDFを出力するための新規フォルダを作成します。
場所はユーザー選択で取得したCATDrawingファイルがまとまっているフォルダ内としています。
その際、すでに同名のフォルダがある場合はマクロを中断させる処理になっています。

フォルダの新規作成/同名フォルダの存在確認のコードは「FileSystemオブジェクト」ページで詳しく解説しているので、リンク先ページを参照ください。

ﾌｫﾙﾀﾞ内ﾙｰﾌﾟでDXF/PDF出力

 'ﾌｫﾙﾀﾞ内ﾙｰﾌﾟでDXF/PDF出力
    For Each f In fs
        
        If InStr(f.Name, ".CATDrawing") <> 0 Then
            
         'ﾄﾞｷｭﾒﾝﾄ(CATDrawing)を開く
            Dim doc As DrawingDocument
            Set doc = CATIA.Documents.Open(fold_path & "\" & f.Name)                                     '"
            
         'ﾌｧｲﾙ名(ﾊﾟｽ)作成
            Dim FileName As String
            FileName = new_fold_path & "\" & Replace(doc.Name, ".CATDrawing", "")                         '"
         
         '図面出力
            Call doc.ExportData(FileName, "dxf")    'dxfで出力
            Call doc.ExportData(FileName, "pdf")    'pdfで出力
        
         'ﾄﾞｷｭﾒﾝﾄ(CATDrawing)を閉じる
            doc.Close
            
        End If
    Next f