/ BLOG / RENAME PARTNAME TO FILENAME

CATScript Rename Partname to Filename

The script can be used to ensure that the part name (inside the CAD-Model) is the same as the given file name. The script recursively scans a given directory and takes any “.CATPart” + “.CATProduct” model into account.

Once this is done, the file name of each catia file is used to re-define each individual model’s partname (if required) and the current file is saved back to disk.

Use this script when working with Catia in plain file mode to improve data quality. The macro can be a real time saver as it operates on directories to perform the required action for all available files automaticly.

Prerequisites:

When running the script, an excel-sheet report is generated, so Excel must be installed on your workstation.

Installation notes:

At the beginning of the script there are a few variables which you need to fine-tune to meet your actual project requirements.

  • DEFAULT_DIR

    this variable is used to specify the root directory where your actual project data can be found (CAD data file storage). Please specify a full-path e.g. like: C:\Projects

  • FILE_STORAGE_DIR

    this variable is used to specify where to store the generated report file (excel-file)


Usage:

  • Start Catia and run this macro - it is not necessary, to load any model.
  • Then select a directory where to find CATPart + CATProduct models.
  • Once finished you can take a look at the report file to see what changes where done.
' -----------------------------------------------------------------------------
' Rename_PartName_2_FileName.CATScript ---
' -----------------------------------------------------------------------------
' (c) 2015, Johann Oberdorfer - Engineering Support | CAD | Software
'     johann.oberdorfer [at] gmail.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


Download:

The script can also be downloaded from the link provided below: