Export All Drawings 2 PDF
PURPOSE:
This utility CATScript macro for CatiaV5 can be used to create
PDF documents for all CATDrawing files which are stored in a directory structure.
Starting from a given directory, the function recursively searches all sub-directories, trying to find every drawing document down below the directory tree.
USAGE:
Start Catia and run this macro, (it is not necessary, to load any model).
A directory selection dialog pops up and the user is asked to select a directory where to start from.
Another directory selection is required to specify, where to store the generated PDF’s.
That’s basically it - the function does the PDF creation automatically.
The created PDF files are organized in the output directory in a directory structure, making it easy to find the generated PDF’s.
Note: The macro also generates a summary provided as an excel file. So, Excel need to be installed on the local CAD station as well.
REMARKS:
The Macro does not modify any data,
- CAD models are opend and closed without modification.
The output directory name is created with a unique timestamp,
which makes it impossible to overwrite already existing PDF files, in case the macro is called repetively more than once.
SOURCE CODE:
' -----------------------------------------------------------------------------
' Export_All_CATDrawings_2_PDF.CATscript --
' -----------------------------------------------------------------------------
' (c) 2012, Johann Oberdorfer - Engineering Support | CAD | Software
' johann.oberdorfer [at] googlemail.com
' www.johann-oberdorfer.eu
' -----------------------------------------------------------------------------
' This source file is distributed under the BSD license.
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
' See the BSD License for more details.
' -----------------------------------------------------------------------------
' -----------------------------------------------------------------------------
' Purpose:
' Use this script to create PDF Drawings for all CATDrawing files which are
' stored in a given directory. All sub-directories are taken into account as
' well.
'
' Usage:
' - Start Catia and run this macro.
' (It is not necessary, to load a model.)
' - Select a directory where to find CATDrawing models.
' - That's basically it - the function does the PDF creation automatically.
'
' The Macro does not modify any data, CAD models are opend and closed
' without doing any modification.
' -----------------------------------------------------------------------------
' Revision History:
' June 2012: J.Oberdorfer, Initial Release
' -----------------------------------------------------------------------------
' TO-DO:
' OO-Integration if there is no Excel installation available
Option Explicit
Language = "VBSCRIPT"
' -- Begin: Configuration Section --
Const TITLE = "Export_All_CATDrawings_2_PDF V1.0"
Const DEFAULT_DIR = ""
Const EXPORT_DIR = ""
Const KEEP_EXCEL_ONSCREEN = True
Const COLOR_LIGHTGREY = 15
Const EXPORT_FILE_EXT = "pdf"
Const CREATE_SUBFOLDER = True
' -- End: Configuration Section --
' -------------------------
' begin - utility functions
' -------------------------
Sub StrAppend ( ByRef str_list() As String, ByVal str As String )
ReDim Preserve str_list (UBound(str_list) + 1)
str_list(UBound(str_list)) = str
End Sub
' // get the filename from a given full path filename
' //
Function GetFileTailName (ByVal full_path_name As String) As String
Dim arr As Array
Dim fs As FileSystem
Set fs = CATIA.FileSystem
arr = split (full_path_name, fs.FileSeparator, -1, vbTextCompare)
' remove leading path, file name is the last item of
' the array returned by the split function
GetFileTailName = arr ( UBound(arr) )
End Function
' // get the parent directory name from a given full path filename
' //
Function GetParentDirName (ByVal full_path_name As String) As String
Dim arr As Array
Dim fs As FileSystem
Set fs = CATIA.FileSystem
arr = split (full_path_name, fs.FileSeparator, -1, vbTextCompare)
' remove leading path, file name is the last item of
' the array returned by the split function
GetParentDirName = arr ( UBound(arr) - 1 )
End Function
Function GenerateTimeStamp () As String
Dim time_str, _
day_str, mon_str, date_str As String
Dim d, m As Integer
time_str = Replace (Time, ":", "", 1, -1, vbTextCompare)
' date_str = Replace (Date, "/", "_", 1, -1, vbTextCompare)
d = Day(Date)
If ( d > 9 ) Then
day_str = CStr(d)
Else
day_str = "0" + CStr(d)
End If
m = Month(Date)
If ( m > 9 ) Then
mon_str = CStr(m)
Else
mon_str = "0" + CStr(m)
End If
date_str = CStr(Year (Date)) + "-" + mon_str + "-" + day_str
GenerateTimeStamp = Replace (date_str + "_" + time_str, " ", "_", 1, -1, vbTextCompare)
End Function
Function SelectDirectory (_
ByVal default_dir As String, _
ByVal usr_message As String, _
ByRef selected_folder As String _
) ' As Boolean
Dim os, msg1 As String
Dim fs As FileSystem
Set fs = CATIA.FileSystem
os = CATIA.SystemConfiguration.OperatingSystem
selected_folder = ""
msg1 = "User Selection:" + vBNewLine + usr_message
' intel_a, solaris_a, aix_a, win_a and hpux_a.
If ( (Instr(os, "win_") <> 0) OR _
(Instr(os, "intel_") <> 0) ) Then
Dim shell, folder
folder = vBNull
Set shell = CreateObject ( "Shell.Application" )
Set folder = shell.BrowseForFolder (0, msg1, 0, default_dir)
If ( IsObject (folder) AND TypeName (folder) <> "Nothing" ) Then
selected_folder = folder.Self.Path
End If
Else
' select a directory...
selected_folder = InputBox (msg1, "Define Directory", default_dir)
End If
If (Not fs.FolderExists (selected_folder)) Then
MsgBox "No directory selected!" + vBNewLine _
+ "Going to exit the macro now.", vbInformation + vbOKOnly, "User Information:"
SelectDirectory = False
Exit Function
End If
SelectDirectory = True
End Function
' -------------------------
' end - utility functions
' -------------------------
' -------------------------------
' Begin - Excel library functions
' -------------------------------
' // Open Excel Application for writing
' //
Function OpenExcelAppForWriting ( ByRef objExcel, ByRef objSheet) As Boolean
OpenExcelAppForWriting = False
Err.Clear : On Error Resume Next
Set objExcel = CreateObject ("EXCEL.Application")
If Err.Number <> 0 Then
MsgBox "Warning: Excel application not found.", vbCritical
Err.Clear : On Error Goto 0
Exit Function
End If
If ( KEEP_EXCEL_ONSCREEN = True ) Then
objExcel.Application.Visible = True
End If
' create a new workbook
Err.Clear : On Error Resume Next
set workbook = objExcel.WorkBooks.Add()
' - disabled- non critical error message !
' If Err.Number <> 0 Then
' MsgBox "Error when trying to set the current workbook in Excel!"
' End If
Err.Clear : On Error Goto 0
Set objSheet = objExcel.ActiveSheet
objSheet.Name = "PartList"
objSheet.Select
OpenExcelAppForWriting = True
End Function
' // SaveAs... the spreadsheet.
' //
Sub SaveAsExcelApplication (ByVal objExcel, ByVal fileName As String)
Dim fs As FileSystem
Set fs = CATIA.FileSystem
' ActiveWorkbook.SaveAs:
' if the file already exists, the user gets a dialog,
' to specify whether to overwrite the file or not...
' as a workaround, we delete the file prior to the save operation!
Err.Clear : On Error Resume Next
If ( fs.FileExists(fileName) ) Then
fs.DeleteFile fileName
If Err.Number <> 0 Then
MsgBox "Error when trying to delete excel file: " + fileName + vBNewLine _
+ "--> Please close Excel Application and try again!"
Err.Clear : On Error Goto 0
Exit Sub
End If
End If
' ??? problem on some workstations / excel versions:
Err.Clear : On Error Resume Next
objExcel.ActiveWorkbook.SaveAs fileName
If Err.Number <> 0 Then
MsgBox "Error in excel - saveas operation went wrong for: " + fileName + vBNewLine _
+ "--> Please save your Excel sheet manually!"
Err.Clear : On Error Goto 0
End If
Err.Clear : On Error Goto 0
End Sub
' // Save the spreadsheet and close the workbook.
' //
Sub CloseExcelApplication (ByVal objExcel, ByVal fileName As String)
Dim fs As FileSystem
Set fs = CATIA.FileSystem
objExcel.ActiveWorkbook.Save ' fileName
If ( KEEP_EXCEL_ONSCREEN = False) Then
objExcel.ActiveWorkbook.Close
objExcel.Application.Quit
End If
End Sub
' -------------------------------
' End - Excel library functions
' -------------------------------
' -----------------------------------------------------------------------------
' Unique macro code basically starts here ...
' -----------------------------------------------------------------------------
Sub ScanDir ( _
ByVal curr_dir As String, _
ByVal filename_pattern As String, _
ByRef file_list() As String _
)
Dim i As Integer
Dim sub_dir_name As String
Dim file_sys as FileSystem
Set file_sys = CATIA.FileSystem
Dim files As Collection
Dim dir, sub_folders As File
' folders...
Set dir = file_sys.getFolder (curr_dir)
Set sub_folders = dir.SubFolders
For i = 1 To sub_folders.Count
sub_dir_name = file_sys.ConcatenatePaths (curr_dir, sub_folders.Item(i).Name)
ScanDir sub_dir_name, filename_pattern, file_list
Next
' and files...
Set files = dir.Files
For i = 1 To files.Count
' apply filter:
If ( InStr(files.Item(i).Name, filename_pattern) <> 0 ) Then
' MsgBox curr_dir + " : " + files.Item(i).Name
StrAppend file_list, _
file_sys.ConcatenatePaths (curr_dir, files.Item(i).Name)
End If
Next
End Sub
' -----------------------------------------------------------------------------
' // performs the following actions:
' // - Select a directory
' // = retrieve all CATPart models behind the selected dir (recursively)
' // = open each individual model in Catia and apply a sub-function on it
' // = collect all output into an excel sheet
' // = close the model and proceed with the next item in the list
' //
' -----------------------------------------------------------------------------
Sub CATMain ()
Dim i, usr As Integer
Dim selected_folder, _
file_list(), current_export_dir, _
model_name, spread_sheet_file, spread_sheet_path, _
time_stamp, sub_dir, export_file_name, parent_dir_name As String
Dim fs As FileSystem
Dim current_doc As PartDocument
CATIA.StatusBar = "Executing: " + TITLE
Set fs = CATIA.FileSystem
' CATIA.RefreshDisplay = False
' select directory where to start from ...
If ( SelectDirectory ( DEFAULT_DIR, _
"Select directory where to search for CATDrawing models:", _
selected_folder) = False ) Then
Exit Sub
End If
' collect files from the server ...
ReDim file_list(0)
ScanDir selected_folder, ".CATDrawing", file_list
If (UBound(file_list) = 0 ) Then
MsgBox "There are no 2D CATDrawing models in the selected directory!" + vBNewLine _
+ "Select another directory and try again.", vbInformation + vbOKOnly, "User Information:"
Exit Sub
End If
' now, process each CATDrawing ...
If (UBound(file_list) > 10 ) Then
usr = Msgbox( _
"There are " + CStr (UBound(file_list)) + " CATDrawing models available." + vBNewline _
+ "Processing these files might take a while." + vbNewLine _
+ "Would you like to continue ?", _
vbQuestion + vbOkCancel, "Question:")
If ( usr <> 1 ) Then
Exit Sub
End If
End If
' here we go ...
' -- specify export directory...
IF ( SelectDirectory ( EXPORT_DIR, _
"Select directory where to store PDF files:", _
current_export_dir) = FALSE ) Then
Exit Sub
End If
sub_dir = GenerateTimeStamp() + "_PDFExport"
current_export_dir = fs.ConcatenatePaths(current_export_dir, sub_dir)
' If ( Msgbox( _
' "About to export " + CStr(Ubound(file_list)) + " CATPart model(s)." + vBNewline _
' + "Export directory used: " + current_export_dir + vBNewline _
' + vBNewline _
' + "Do you like to continue?", _
' vbQuestion + vbOkCancel, "Question:") = 2 ) Then
' Exit Sub
' End If
fs.CreateFolder(current_export_dir)
time_stamp = GenerateTimeStamp ()
spread_sheet_file = "PDFExport_" + time_stamp + ".xls"
spread_sheet_path = fs.ConcatenatePaths(current_export_dir, spread_sheet_file)
' -----------------------------------------------------------
Dim objExcel, objSheet ' type declaration omitted (I don't know yet...)
If (OpenExcelAppForWriting(objExcel, objSheet) <> True ) Then
Exit Sub
End If
' -----------------------------------------------------------
' create new file...
SaveAsExcelApplication objExcel, spread_sheet_path
' header line + format
Dim col_index As Integer
Dim rowcnt As integer
col_index = 1
rowcnt = 2
objSheet.Range("A1:C1").Font.Bold = True
objSheet.Range("A1:C1").Interior.ColorIndex = COLOR_LIGHTGREY
' "A" / "B" / "C"
objSheet.Cells(1, col_index).Value = "Count:" : objSheet.Columns(col_index).ColumnWidth = 10
objSheet.Cells(1, col_index + 1).Value = "File Name:" : objSheet.Columns(col_index + 1).ColumnWidth = 180
objSheet.Cells(1, col_index + 2).Value = "Exported PDF Name:" : objSheet.Columns(col_index + 2).ColumnWidth = 80
' loop through the file list ...
For i = 1 To UBound(file_list)
rowcnt = rowcnt + 1
' process each CAD model ...
Set current_doc = CATIA.Documents.Open( file_list(i) )
model_name = GetFileTailName ( file_list(i) )
model_name = Replace (model_name, ".CATDrawing", "." + EXPORT_FILE_EXT, 1, -1, vbTextCompare)
If (CREATE_SUBFOLDER = True) Then
' extract parent folder name from the full path name
' and add it to the export directory path name:
parent_dir_name = GetParentDirName ( file_list(i) )
export_file_name = fs.ConcatenatePaths(current_export_dir, parent_dir_name)
' create the directory (if required)...
If (Not fs.FolderExists(export_file_name)) Then
fs.CreateFolder(export_file_name)
End If
End If
export_file_name = fs.ConcatenatePaths(export_file_name, model_name)
current_doc.ExportData export_file_name, EXPORT_FILE_EXT
current_doc.Close()
objSheet.Cells(rowcnt, 1).Value = CStr(i) + " of " + CStr(UBound(file_list))
objSheet.Cells(rowcnt, 2).Value = file_list(i)
objSheet.Cells(rowcnt, 3).Value = export_file_name
CATIA.StatusBar = "Processing: " + _
CStr(i) + " of " + CStr(UBound(file_list)) + " " + _
export_file_name
' scroll to current row...
objSheet.Cells(rowcnt, 1).Select
Next
' once finished, jump to the beginning of the sheet
objSheet.Cells(1, 1).Select
CloseExcelApplication objExcel, spread_sheet_path
MsgBox "PDF export finished!" + vBNewLine _
+ "Excel sheet successfully created: " + vbNewLine _
+ spread_sheet_path , _
+ vbInformation + vbOKOnly, "User Information:"
End Sub
Download Link:
The software is also available in the related CATScript download area:
| Size / byte: | Name: | |
|---|---|---|
| 4542 | ExportAllDrawings2PDF.zip | |
| 4102 | ProductToStepExportV1.CATScript.zip |
comments powered by Disqus