Export All Drawings 2 PDF

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