指定したフォルダ内のすべての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の両方に対応させていますが、片方が不要な場合はコード解説を参考に該当処理をコメントアウトしてください。
マクロの機能
今回作成したマクロは指定したフォルダ内のすべてのCATDrawingをDXF/PDFファイルで出力するマクロです。選択したフォルダ内にCATDrawing以外のものがあっても実行できるようになっています。具体的な機能は以下のとおりです。
・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
コード解説
定数の定義
'定数の定義 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
まずはユーザー選択により出力する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ファイルがあるかを確認します。
先ほど取得した「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)
つぎに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
つぎにDXF/PDFファイルとして出力していきます。
処理の流れとしては下記のとおりです。
フォルダ内ループの方法は「CATDrawingファイルがあるか確認」で解説したとおりです。
① CATDrawingファイルを開く
② ファイル名を作成(ファイル名はドキュメント名にする)
③ DXF/PDFとして新規作成したフォルダに出力
④ CATDrawingファイルを閉じる
上記の通り、手動操作でやっていることをそのままプログラム化したような処理となっています。
DXF/PDFの片方が不要な場合は、いずれかの「Call ~」の1行をコメントアウトしてください。
まとめ
今回は「指定したフォルダ内のすべてのCATDrawingをDXF/PDFファイルで出力するマクロ」についての内容でした。基本的には「CATDrawingをDXF/PDFファイルで出力」ページのマクロの範囲を広げただけのマクロで、書き出しの処理内容としては同じものを使用しています。
重要なのはフォルダやファイルといったアプリケーション(CATIA)外をVBAで操作するという点です。
フォルダやファイルを操作するには「FileSystemオブジェクト」を使います。
CATIAの場合は下記の2通りの方法でFileSystemオブジェクトが取得できます。
Dim fso
Set fso = CATIA.FileSystem 'CATIA専用の書き方
Set fso = CreateObject(“Scripting.FileSystemObject") 'VBA共通の書き方
上記2つのどちらで書いても問題ないので好きな書き方で使用してください。
ただ、CreateObject関数を使った取得方法はExcelやAccessなどでも使える方法なので、他のアプリケーションでも開発する機会がある場合はこちらの方法を覚えておいたほうが良いかもしれません。
CATIAマクロを本気で勉強するなら
