' -----------------------------------------------------------------------------
' GENERIC_Rename_PartName_2_FileName.CATScript --
' -----------------------------------------------------------------------------
' (c) 2015, 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:
'   The script can be used to ensure, part name is the same as the given
'   file name.
'   The script takes *.CATPart + *.CATProduct models into account.
'
' Usage:
'    - Start Catia and run this macro.
'        (It is not necessary, to load a model.)
'    - Select a directory where to find CATPart + CATProduct models.
'
' -----------------------------------------------------------------------------
' Revision History:
'  15-09-20: J.Oberdorfer, Initial Release
' -----------------------------------------------------------------------------

' Option Explicit
Language="VBSCRIPT"

' -- Configuration Section

Const DEFAULT_DIR = "C:\Projects"
Const REPLACE_SPACE_WITH_UNDERSCORE_IN_FILENAME = True

Const FILE_STORAGE_DIR = "C:\local"
Const KEEP_EXCEL_ONSCREEN = True
Const COLOR_LIGHTGREY = 15
Const COLOR_LIGHTGREEN = 35
Const COLOR_ORANGE = 44


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


Function SelectDirectory (_
			ByVal default_dir 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 + _
			"Select directory where to search for CATPart models:"

	' 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


' //
' // try to find *.CATPart and *.CATProduct models
' // starting from a given directory name and below (recursive scan)
' //

Sub FindAllPartsAndProducts ( _
		ByVal curr_dir 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)
		FindAllPartsAndProducts sub_dir_name, file_list
	Next

	' and files...
	Set files = dir.Files

	For i = 1 To files.Count
		' apply filter:
		If ( ( InStr(files.Item(i).Name, ".CATPart") <> 0 ) OR _
			 ( InStr(files.Item(i).Name, ".CATProduct") <> 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


Function RemoveExtension (ByRef str As String) As String

	Dim str_array As Array

	str_array = Split(str, ".")
	RemoveExtension = str_array(0)
	
	For i = 1 To Ubound(str_array) - 1
		RemoveExtension = RemoveExtension + "." + str_array(i)
	Next

End Function

Function RemovePathFromName (ByVal path_name As String) As String
	Dim i As Integer
	Dim arr As Array
	
	arr = Split( path_name, "\", -1,1)

	For i = 0 To UBound (arr)
		RemovePathFromName = arr(i)
	Next

End Function


' -------------------------
' End - utility functions
' -------------------------

' -------------------------------
' Begin - Excel library functions
' -------------------------------

Function GenerateTimeStamp () As String
	Dim time_str As String
	Dim date_str As String
	
	time_str = Replace (Time, ":", "_", 1, -1, vbTextCompare)
	date_str = Replace (Date, "/", "_", 1, -1, vbTextCompare)

	GenerateTimeStamp = Replace (time_str + date_str , " ", "_", 1, -1, vbTextCompare)
End Function


' // usefull for app' development
' //   - if path_name points to a valid directory, then
' //     use this location for read/write operations,
' //   - otherwise use the os-dependent temporary storage location
' //
Function DefineTempFileLocation (ByVal path_name As String, ByVal file_name As String) As String
	Dim temp_dir As String
 	Dim fs As FileSystem
	Set fs = CATIA.FileSystem
	
	If ( fs.FolderExists(path_name) ) Then
		temp_dir = path_name
	Else
		' distinguish between operating systems
		' see as well: fs.TemporaryDirectory which might also serve the purpose

		If ( Instr(1, CATIA.SystemService.Environ("OS"), "Win") > 0 ) Then
			temp_dir = InitSystemVariable("TEMP")
		Else
			temp_dir = InitSystemVariable("HOME")
		End If
	End If
	
	DefineTempFileLocation = fs.ConcatenatePaths(temp_dir, file_name)
End Function


' // 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." + vbNewLine + _
			"Proceed with macro execution but with reduced instruction set!", _
			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
' -------------------------------


' -----------------------------------------------------------------------------
' // Perform the following actions:
' // - Select a directory
' //     = retrieve all CATParts and CATProducts in the selected dir
' //       and create a reference list
' //     = open each individual CATPart / CATProduct in Catia and
' //       perform rename (if required).
' //     = save / (or close) the current model and proceed with next item ...
' //
' -----------------------------------------------------------------------------

Sub CATMain ()

	Dim i, rename_cnt, _
		simulation_mode, _
		excel_is_available As Integer

	Dim col_index As Integer
	Dim rowcnt    As integer

	Dim selected_folder     As String
	Dim	part_name, new_name As String
	Dim file_list()     	As String

	Dim spread_sheet_file As String
	Dim spread_sheet_path As String
	
	Dim time_stamp 	As String
	Dim indexStr 	As String
	Dim msg_str 	As String
	Dim current_doc As PartDocument
	Dim active_part_or_product As Product

	CATIA.RefreshDisplay = False
	
	' ----------------------------------------
	' -- select directory where to start from ...
	' ----------------------------------------
	
	If ( SelectDirectory (DEFAULT_DIR, selected_folder) = False ) Then
		Exit Sub
	End If

	' -----------------------------------------------------------
	' -- attempt to find all available CATParts + CATProducts ...
	' -----------------------------------------------------------
	ReDim file_list(0)

	FindAllPartsAndProducts selected_folder, file_list
	
	If (UBound(file_list) = 0 ) Then
		MsgBox _
			"There are no CATPart or CATProduct files in the selected directory!" + vbNewLine + _
			"Select another directory and try again.", _
			vbInformation + vbOKOnly, "User Information:"
		Exit Sub
	End If

	' ------------------------------------------
	' -- ask the user, what option to choose ...
	' ------------------------------------------

	Select Case _
		Msgbox( _
			"There are " + CStr (UBound(file_list)) + " CATParts/CATProducts available." + vbNewLine + _
			"Processing these files might take a while." + vbNewLine + _
			vbNewLine + _
			"YES = Continue with rename operation (default option)" + vbNewLine + _
			"NO = Continue in simulation mode (see what might happen, no model changes are performed)", _
			vbYesNoCancel + vbQuestion, "Question:" )
		Case 6
			' 6 = YES
			simulation_mode = 0
		Case 7
			' 7 = NO
			simulation_mode = 1
		Case 2
			' CANCEL
			Exit Sub
	End Select

	' ------------------
	' --- here we go ...
	' ------------------

	time_stamp = GenerateTimeStamp ()
	spread_sheet_file = "Synchronize_PartName_with_FileName" + time_stamp + ".xls"
	spread_sheet_path = DefineTempFileLocation(FILE_STORAGE_DIR, spread_sheet_file)

	' -----------------------------------------------------------
	Dim objExcel, objSheet ' type declaration omitted (I don't know yet...)

	If (OpenExcelAppForWriting(objExcel, objSheet) <> True ) Then
		excel_is_available = 0
	Else
		excel_is_available = 1

		' create new file...
		SaveAsExcelApplication objExcel, spread_sheet_path

		' header line + format
		col_index = 1
		rowcnt = 2
	
		objSheet.Range("A1:B1").Font.Bold = True
		objSheet.Range("A1:B1").Interior.ColorIndex = COLOR_LIGHTGREY

		objSheet.Cells(1, col_index).Value =     "File Name"	 : objSheet.Columns(col_index).ColumnWidth = 120	' "A"
		objSheet.Cells(1, col_index + 1).Value = "Part Name"     : objSheet.Columns(col_index + 1).ColumnWidth = 60	' "B"
		objSheet.Cells(1, col_index + 2).Value = "Rename Action" : objSheet.Columns(col_index + 2).ColumnWidth = 80	' "C"
	End If
		
	' o.k. - Process each CATProduct ...
	rename_cnt = 0

	For i = 1 To UBound(file_list)
		rowcnt = rowcnt + 1
		Set current_doc = CATIA.Documents.Open( file_list(i) )

		Set active_part_or_product = current_doc.Product
	
		part_name = active_part_or_product.PartNumber

		new_name = RemoveExtension( current_doc.Name )
		new_name = RemovePathFromName( new_name )

		If ( part_name <> new_name) Then

			If ( simulation_mode = 0 ) Then
				' MsgBox "--> " + part_name + " : " + new_name

				' ------------------------------------------
				active_part_or_product.PartNumber = new_name
				current_doc.Save()
				' ------------------------------------------

				rename_cnt = rename_cnt + 1
				msg_str = "Renamed to: "
				msg_color = COLOR_LIGHTGREEN
			Else
				msg_str = "Will be renamed to: "
				msg_color = COLOR_ORANGE
			End If
			
		Else
			msg_str = "Names are equal: "
			msg_color = ""
		End If

		If (excel_is_available = 1) Then
			objSheet.Cells(rowcnt, 1).Value = file_list(i)
			objSheet.Cells(rowcnt, 2).Value = part_name
			objSheet.Cells(rowcnt, 3).Value = msg_str + new_name

			If (msg_color <> "" ) Then
				indexStr = "C" + CStr(rowcnt)
				objSheet.Range(indexStr).Interior.ColorIndex = msg_color
			End If
		
			' scroll to current row...
			objSheet.Cells(rowcnt, 1).Select
		End If
		
		current_doc.Close()

	Next
	
	MsgBox _
		"Macro finished!" + vbNewLine + _
		"Part / Component rename count: " + CStr ( rename_cnt ), _
		vbInformation + vbOKOnly, "User Information:"

	'If (excel_is_available = 1) Then
	'	CloseExcelApplication objExcel, spread_sheet_file
	'End If

End Sub