CATScript - Questions & Answers

The macro directory is meant to be the directory where the actual macro file is located on disc. In CATIA it does not seem to be possible to retrieve this directory at runtime, or at least I was not able to figure it out.

So the only way is to hard-code e.g. a path to a support file which needs to be loaded from within a CATScript macro.

Yes, this is possible, here is a sample code to illustrate the call:

' Option Explicit
Language = "VBSCRIPT"

Const PATH_NAME = "<your path here>"
Const CUSTOM_DLG = "CustomDialogClass.CATScript"
Const DELIM = "@"

Sub CATMain()
	Dim usr As Variant
	Dim params() As Variant
	
	ReDim params(2)
	params(0) = 350
	params(1) = 420
	params(2) = _
		"The quick brown fox" + DELIM + _
		"*jumps over" 		  + DELIM + _
		"the lazy dog."

	usr = CATIA.SystemService.ExecuteScript ( _
			PATH_NAME, catScriptLibraryTypeDirectory, _
			CUSTOM_DLG, "CustomDialogClass_Cmd", params)

	If (Len(usr) = 0) Then
		MsgBox "Nothing selected!"
	Else
		MsgBox "You selected: '" + usr + "'"
	End If
End Sub

The following function might be useful to ensure that CDbl works correctly with the decimal separator setting.

Determining the internal decimal separator is not required unless you are dealing with data created somewhere else. For example, if you would like to create a macro for importing a point cloud into CATIA, in this case you would probably want to validate and possibly convert numbers if needed.

' read decimal separator value from registry
'
Function GetInternationalDecimal (ByRef val As String) As Boolean
	Dim wsh As IWshShell3
	GetInternationalDecimal = False

	Err.Clear : On Error Resume Next

	val = ""
	Set wsh = CreateObject("WScript.Shell")
	val = wsh.RegRead("HKCU\Control Panel\International\sDecimal")
	wsh = Nothing

	On Error Goto 0

	If (Err.Number <> 0 Or val = "") Then
		Exit Function
	End If
	GetInternationalDecimal = True
End Function

' // Test Call
' //
Sub CATMain ()
	Dim val,msg As String

	' MsgBox CATIA.SystemConfiguration.OperatingSystem

	If Not GetInternationalDecimal(val) Then
		MsgBox "Error: unable to read current decimal setting!"
		Exit Sub
	End If

	Select Case val
		Case ".":  msg = "point"
		Case ",":  msg = "comma"
		Case Else: msg = val
	End Select

	MsgBox "Current international decimal setting: " + msg
End Sub

The solution is to define a class MyCustomData with the data structure as required and in a 2nd step create an array variable as usual.

For each item of the array, the custom class can be given as argument. Note that as the given argument is from type “Class”, the “Set” operator must be used.

Once this is done, the dot notation arr(i).str = str can be used to refer to each individual custom data item.

Class MyCustomData
	Public str As String
	Public val As Variant
	' ... more data types to be added here (if required)
End Class

Sub AddItem (_
		ByRef arr() As MyCustomData, _
		ByVal str As String, ByVal val As Variant)
	Dim i As Long

	ReDim Preserve arr(UBound(arr) + 1)
	i = UBound(arr)
	Set arr(i) = New MyCustomData
	arr(i).str = str
	arr(i).val = val
End Sub


Sub CATMain ()
	Dim i As Long
	Dim item As MyCustomData
	Dim custom_array() As MyCustomData
	ReDim custom_array(-1)

	AddItem custom_array, "test", 99
	AddItem custom_array, "width", 100
	AddItem custom_array, "height", 20
	AddItem custom_array, "dummy_value", "not set"

	' loop through 
	' For i = LBound(custom_array) To Ubound(custom_array)
	'	MsgBox custom_array(i).str + " = " + CStr( custom_array(i).val)
	' Next

	For Each item In custom_array
		MsgBox item.str + " = " + CStr(item.val)
	Next

End Sub

Recently I made some minor changes to the code snippet mainly to correct the array data index which not starts at 0 (together with ReDim custom_array(-1)). The custom_array value is now declared as type MyCustomData and no Variant any more. Also note that in the Class declaration Public is used instead of Dim.

Question about garbage collection and freeing up memory after the usage:

Do I need to clean up the Custom Array after usage?

In almost all real-world code written, you do NOT need to explicitly set a custom array (or any object/array) to Nothing or use Erase just to “clean up” before the variable goes out of scope. The runtime and garbage collector handle it automatically.

There might be use cases where it seems more logic to clean up memory on a certain stage. Doing so I would propose to use a 2 step approach:

• loop throuch each item to free up memory:

  	For Each item In custom_array
  		Set item = Nothing
  	Next
  
  

• and finally use Erase

  	Erase custom_array
  

The clipboard offers a possibility to pass data to and from a separate process without the need of an intermediate transfer file. A use case could be e.g. to implement a dialog window (HTA application or MSEdge browser) which can be called from within a CATScript main caller program. Data passed pack to the caller could be transfered back via the clipboard.

Here are 2 functions which serve this purpose quite nicely:

Function GetClipboardText() As String
	Dim str As String
	Dim html As HtmlDocument

	Set html = CreateObject("htmlfile")
	str = html.ParentWindow.ClipboardData.GetData("text")

	If TypeName(str) = "Null" Then
		GetClipboardText = ""
	Else
		GetClipboardText = str
	End If
	Set html = Nothing
End Function

Sub CopyToClipboard(ByVal str As String) As String
	Dim html As HtmlDocument
	Set html = CreateObject("htmlfile")
	html.ParentWindow.ClipboardData.SetData "text", str
	Set html = Nothing
End Sub

Another alternative is to use a WScript.Shell object. This approach works as well, but it has a drawback: during the Exec call, a console window briefly flashes on the screen — an annoying distraction for the user.

' procedure works but when using Exec,
' the terminal window is shown for a fraction of seconds
Sub CopyToClipboard (ByVal str As String)
	Dim wsh As IWshShell3
	Dim exe As WshExec
	Dim stream As TextStream
	
	Set wsh = CreateObject("WScript.Shell")
	Set exe = wsh.Exec("clip")
	Set stream = exe.stdIn
	stream.WriteLine str
	stream.Close
	Set wsh = Nothing
End Sub

Sub CopyToClipboard (ByVal str As String)
	Dim wsh As IWshShell3
	
	Set wsh = CreateObject("WScript.Shell")
	wsh.Run "cmd.exe /C echo " & str & " | clip.exe", 0, True
	Set wsh = Nothing
End Sub

Example usage:

Sub CATMain()
	Dim str As String
	CopyToClipboard "Hello World !"
	str = GetClipboardText()
	MsgBox str,, "Clipboard text currently available:"
End Sub

The following code example illustrates the possibility to call excel directly from CATScript. Excel will be launched and some sample information will then be written to it.

Hint: In this scenario it is important that the current excel file has a unique file name otherwise excel will possibly raise an error.

The code could be handy if e.g. during macro execution some kind of (process-) information needs to be written and kept as evidence/reference for the user.

Class CustomExcelFactory

	' type declaration omitted, will be declared at runtime...
	Private obj_excel, obj_sheet
	Private keep_excel_on_screen As Boolean

	' do something when the class is initialized
	Private Sub Class_Initialize ()
        keep_excel_on_screen = True
    End Sub

    Public Property Let KeepExcelOnScreen (ByVal excel_on_screen As Boolean)
        keep_excel_on_screen = excel_on_screen
    End Property
	
   ' define the public properties
    Public Property Get objSheet ()
        Set objSheet = obj_sheet
    End Property
	
	' // open Excel Application for writing
	' //
	Public Function OpenExcelAppForWriting () As Boolean
		OpenExcelAppForWriting = False
		
		Err.Clear : On Error Resume Next
		Set obj_excel = 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_on_screen = True Then
			obj_excel.Application.Visible = True
		End If
		
		' create a new workbook
		Err.Clear : On Error Resume Next
		set workbook  = obj_excel.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 obj_sheet = obj_excel.ActiveSheet
		obj_sheet.Select
		' obj_sheet.Name = "My Sheet Name"
		
		OpenExcelAppForWriting = True
	End Function

	' // SaveAs... the spreadsheet.
	' //
	Public Sub SaveAsExcelApplication (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
		
		obj_excel.ActiveWorkbook.SaveAs fileName

		If Err.Number <> 0 Then
			MsgBox _
				"Error in excel -  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 if required
	' //
	Public Sub CloseExcelApplication ()
		obj_excel.ActiveWorkbook.Save

		If keep_excel_on_screen = False Then
			obj_excel.ActiveWorkbook.Close
			obj_excel.Application.Quit
		End If

	End Sub

End Class

The following procedure shows how to bring the CustomExcelFactory class to live.

• After the Dim XLS As CustomExcelFactory initialization statement, the class object is instantiated with the Set XLS = New CustomExcelFactory command.

• Once the class is available , the 1st command is XLS.OpenExcelAppForWriting which attempts to open or launch excel.

• With XLS.SaveAsExcelApplication a new spreadsheet file is created.

  Note that it is not required to expose the obj_excel to public, the only object which is required as public is XLS.objSheet which in fact refers to excel’s sheet object itself and thus knows all the sub-commands which can be used on CATScript level to define the spreadsheet properties.

• Within the For loop some arbitrary data is written as an example and with the XLS.CloseExcelApplication procedure the excel sheet is finally saved to file. Depending on weather the XLS.KeepExcelOnScreen property is true or false Excel stays on screen or is closed again.

Hint: The created excel sheet is saved on the disk and the user has to take care to manage it afterwards.

' -----------------------------------------------------------------------------
' ---  CustomExcelFactory.CATScript
' -----------------------------------------------------------------------------
' (c) 2023, 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.
' -----------------------------------------------------------------------------
' Option Explicit
Language = "VBSCRIPT"

' --- copy the CustomExcelFactory code to here ---
' --- BEGIN ---
' Class CustomExcelFactory
' ...
' End Class
' --- EOF ---

Sub CustomExcelFactory_test ()
	Dim i,j, col_index, rowcnt As Integer
	Dim temp_dir, time_stamp, _
		spread_sheet_file, _
		spread_sheet_path As String
	Dim fs As FileSystem
	Dim str As Folder
	Dim XLS As CustomExcelFactory

	Set XLS = New CustomExcelFactory
	XLS.KeepExcelOnScreen = True

	i = 1
	j = 10
	col_index = 1
	rowcnt = 2

	' get the user's temporary directory ...
	Set fs = CATIA.FileSystem
	Set str = fs.TemporaryDirectory
	temp_dir = CATIA.SystemService.Environ(str.Name)
	time_stamp = Replace (Time, ":", "", 1, -1, vbTextCompare)

	spread_sheet_file = "Excel_Test_" + time_stamp + ".xls"
	spread_sheet_path = fs.ConcatenatePaths(temp_dir, spread_sheet_file)

	If XLS.OpenExcelAppForWriting() <> True Then
		Exit Sub
	End If
	
	' create new file...
	XLS.SaveAsExcelApplication spread_sheet_path

	XLS.objSheet.Name = "Result-List"
	XLS.objSheet.Range("A1:C1").Font.Bold = True
	XLS.objSheet.Range("A1:C1").Interior.ColorIndex = 15 ' COLOR_LIGHTGREY

	' "A" / "B" / "C"
	XLS.objSheet.Cells(1, col_index).Value     = "Count:"     : XLS.objSheet.Columns(col_index).ColumnWidth = 10
	XLS.objSheet.Cells(1, col_index + 1).Value = "Item Name:" : XLS.objSheet.Columns(col_index + 1).ColumnWidth = 40
	XLS.objSheet.Cells(1, col_index + 2).Value = "Value:"     : XLS.objSheet.Columns(col_index + 2).ColumnWidth = 40

	For i = 1 To j
		rowcnt = rowcnt + 1
		XLS.objSheet.Cells(rowcnt, 1).Value = CStr(i) + " of " + CStr(j)
		XLS.objSheet.Cells(rowcnt, 2).Value = "Test " + CStr(i)
		XLS.objSheet.Cells(rowcnt, 3).Value = "dummy " + CStr(i)
		' scroll to current row...
		XLS.objSheet.Cells(rowcnt, 1).Select
	Next

	' once finished, jump to the beginning of the sheet
	XLS.objSheet.Cells(1, 1).Select
	XLS.CloseExcelApplication
	Set XLS = Nothing

	MsgBox _
		"Excel write test finished!", _
	+ 	vbInformation + vbOKOnly, "User Information:"
End Sub

' execution starts here ...
Sub CATMain ()
	Call CustomExcelFactory_test ()
End Sub

Sometimes it might be useful to refresh the Catia screen so that changes made by a running macro are shown directly on the fly.

One might think that the following command can trigger the update:

	CATIA.RefreshDisplay = True

Unfortunately this statement has no effect. The reason behind is that the RefreshDisplay refers to a member variable of the CATIA object and not to a command. Thus the setting is taken into account after the CATScript macro execution ends.

Fortunately there is a workaround and the following code can be used:

' forces the CATIA window to refresh due to window size change (hack)
' note that "CATIA.RefreshDisplay = True" has no effect inside a running
' macro as this is just a configuration variable setting and
' no subfunction, so no direct action might takes place.
'
Sub CatiaRefreshDisplay ()
	Dim w As Integer
	w = CATIA.ActiveWindow.Width
	CATIA.ActiveWindow.Width = w - 1
	CATIA.ActiveWindow.Width = w
End Sub

The ActiveWindow variable, though still a variable, takes higher priority than RefreshDisplay, causing CATIA to update the screen immediately.

Just add the following line of code in your source:

	' add new Undo/Redo transaction breakpoint
	' to allow to rollback all the operations performed (!) ...
	' ---------------------------------------------------------
	CATIA.EnableNewUndoRedoTransaction()
	' ---------------------------------------------------------

When communicating via the COM interface with CATIA, it might happen that the CATIA application window gets minimized for some reason. I could not figure out what triggers this behavior. Nevertheless the following workaround for this problem seems to work:

Option Explicit
Language="VBSCRIPT"

' workaround in case CATIA application window gets minimized
' typically this might happen when calling up a macro via the
' COM interface, the behavior is a bit unpredictable,
' the following function is a workaround for the problem

Sub MaximizeCatiaWindow ()

	Dim tmp, vbsfile As String
	Dim f As File
	Dim fs As FileSystem
	Dim os As CATIATextStream
	
	Set fs = CATIA.FileSystem

	' suppress error in case something might go wrong
	On Error Resume Next

	tmp = CATIA.SystemService.Environ("TEMP")
	vbsfile = fs.ConcatenatePaths(tmp, "maximize_catiawindow.vbs")
	
	If fs.FileExists(vbsfile) Then fs.DeleteFile(vbsfile)
	
	' store file as a temporary vbs file and execute it...
	Set f = fs.CreateFile(vbsfile, True)
	Set os = f.OpenAsTextStream("ForWriting")
	
	os.Write _
		"Dim capp : Set capp = CreateObject(""WScript.Shell"")" _
	+	" : capp.AppActivate(""CATIA"")" _
	+	" : capp.SendKeys ""% x"""
	os.Close
	
	' the following command sequence is required:
	' cold not achieve to hide cmd window,also tried: "cmd /c start /min """""  + vbsfile
	CATIA.SystemService.ExecuteBackgroundProcessus "cmd /c " + vbsfile
	
	If fs.FileExists(vbsfile) Then
		' wait for a fraction of time ...
		Dim tstart, tstop As Single
		tstart = Timer
		Do : tstop = Timer
		Loop Until tstop - tstart > 0.4
	
		fs.DeleteFile(vbsfile)
	End If

	On Error Goto 0
End Sub


Sub CATMain ()
	Call MaximizeCatiaWindow()
End Sub

Note that the following output file formats are supported:

• catCaptureFormatCGM, catCaptureFormatEMF,
• catCaptureFormatTIFF, catCaptureFormatTIFFGreyScale,
• catCaptureFormatBMP, catCaptureFormatJPEG

Option Explicit
Language="VBSCRIPT"

' initialize defined system variable
Function InitSystemVariable (ByVal varname As String) As String
	Dim str As String
	str = CATIA.SystemService.Environ(varname)

	If Not CATIA.FileSystem.FolderExists(str) Then
		Err.Raise 9999, _
			"Error: WRONG ENVIRONMENT SETTTINGS", _
			"Directory is missing or " + varname + " variable is not set!"
	End If

	InitSystemVariable = str
End Function

' ------------------------
' execution starts here...
' ------------------------
Sub CATMain ()
	Dim temp_dir, plotfile As String

	temp_dir = InitSystemVariable("TEMP")
	plotfile = CATIA.FileSystem.ConcatenatePaths(temp_dir, "test.jpg")

	CATIA.ActiveWindow.ActiveViewer.Reframe
	CATIA.ActiveWindow.ActiveViewer.CaptureToFile catCaptureFormatJPEG, plotfile

	Msgbox "Screen captured and saved to file: " + plotfile

End Sub

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

	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
		Set shell = Nothing
	Else
		' fallback solution, 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

Sub CATMain ()

	Dim selected_folder As String

	Const DEFAULT_DIR = ""

	If Not SelectDirectory ( DEFAULT_DIR, _
			"Select directory where to search for CATDrawing models:", _
			selected_folder) Then
		Exit Sub
	End If
	
	MsgBox "--> " + selected_folder
End Sub

' --- read the content of a given directory

Option Explicit
Language="VBSCRIPT"

Const CATALOG_DIR = _
	"C:\<directory_path_name>"

Sub StrAppend (ByRef str_list() As String, ByVal str As String)
	If Trim(str) <> "" Then
		ReDim Preserve str_list (UBound(str_list) + 1)
		str_list(UBound(str_list)) = str
	End If
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
    GetFileTailName = Trim (arr(UBound(arr)))
End Function

Function RemoveExtension (ByRef str As String, ByVal ext As String) As String
	Dim idx As String
	idx = InStr (1, str, ext, vbTextCompare)
	
	If idx = 0 Then
		RemoveExtension = str
	Else
		RemoveExtension = Left(str, Len(str) - Len(ext))
	End If
End Function

' https://www.johann-oberdorfer.eu/blog/2015/06/03/
'   15-06-03_exportalldrawings2pdf/

Sub GetDirContent ( _
		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
	Dim files As Collection
	Dim dir, sub_folders As File

	Set file_sys = CATIA.FileSystem
	Set dir = file_sys.getFolder (curr_dir)
	Set sub_folders = dir.SubFolders

	' -disabled- recursive call for sub folders...
	' 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
		If InStr(files.Item(i).Name, filename_pattern) <> 0 Then
			StrAppend file_list, _
				RemoveExtension(files.Item(i).Name, filename_pattern)
		End If
	Next
End Sub

' sorting array in ascent sort order (the famous bubble sort)
' https://www.tek-tips.com/viewthread.cfm?qid=1151221#google_vignette
'
Sub SortDataList (ByRef data() As String)
	Dim n,m As Integer
	Dim temp As String

	For n = 1 To UBound(data)
		For m = n + 1 To UBound(data) 
			If data(m) < data(n) Then
				temp = data(m)
				data(m) = data(n)
				data(n) = temp
			End If
		Next
	Next
End Sub


Sub CATMain()

	Dim file_list() AS String : ReDim file_list(0)

	GetDirContent CATALOG_DIR, ".CATPart", file_list
	SortDataList file_list

	MsgBox _
		Join(file_list, vbNewLine), vbOkOnly, _
		"There are " + CStr(UBound(file_list)) + " items available:"

End Sub

' --- read the content of a given directory - CustomGetDirContent Class
Option Explicit
Language="VBSCRIPT"

Const CATALOG_DIR = _
	"C:\<directory_path_name>"


Class CustomGetDirContent

	Private Sub class_StrAppend (ByRef str_list() As String, ByVal str As String)
		If Trim(str) <> "" Then
			ReDim Preserve str_list (UBound(str_list) + 1)
			str_list(UBound(str_list)) = str
		End If
	End Sub
	
	Private Function class_RemoveExtension (_
				ByRef str As String, ByVal ext As String) As String
		Dim idx As String
		idx = InStr (1, str, ext, vbTextCompare)
		
		If idx = 0 Then
			class_RemoveExtension = str
		Else
			class_RemoveExtension = Left(str, Len(str) - Len(ext))
		End If
	End Function

	' sorting array in ascent sort order (the famous bubble sort)
	' https://www.tek-tips.com/viewthread.cfm?qid=1151221#google_vignette
	'
	Public Sub class_SortDataList (ByRef data() As String)
		Dim n,m As Integer
		Dim temp As String

		For n = 1 To UBound(data)
			For m = n + 1 To UBound(data) 
				If data(m) < data(n) Then
					temp = data(m)
					data(m) = data(n)
					data(n) = temp
				End If
			Next
		Next
	End Sub

	' https://www.johann-oberdorfer.eu/blog/2015/06/03/
	'   15-06-03_exportalldrawings2pdf/

	Public Sub GetSortedDirContent ( _
				ByVal curr_dir As String, _
				ByVal filename_pattern As String, _
				ByRef data_list() As String)

		Dim i As Integer
		Dim sub_dir_name As String
		Dim file_sys as FileSystem
		Dim files As Collection
		Dim dir, sub_folders As File

		Set file_sys = CATIA.FileSystem
		Set dir = file_sys.getFolder (curr_dir)
		Set sub_folders = dir.SubFolders

		' -disabled- recursive call for sub folders...
		' 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, data_list
		' Next

		' and files...
		Set files = dir.Files
		For i = 1 To files.Count
			If InStr(files.Item(i).Name, filename_pattern) <> 0 Then
				class_StrAppend data_list, _
					class_RemoveExtension(files.Item(i).Name, filename_pattern)
			End If
		Next

		' finally, sort the list
		If UBound(data_list) > 1 Then class_SortDataList data_list
	End Sub

	Public Sub RemoveItemFromList (ByRef data_list() As String, ByVal pattern As String)
		
		Dim i As Integer
		Dim tmp() As String

		ReDim tmp(0)
		For i = 1 To UBound(data_list)
			If InStr (1, data_list(i), pattern, vbTextCompare) = 0 Then
				ReDim Preserve tmp (UBound(tmp) + 1)
				tmp(UBound(tmp)) = data_list(i)
			End If
		Next

		ReDim data_list(UBound(tmp))
		For i = 1 To UBound(tmp)
			data_list(i) = tmp(i)
		Next
	End Sub

	Public Function SelectItemInputBox ( _
				ByVal data_list() As String, _
				ByRef selected_item As String) As Boolean

		Dim i As Integer
		Dim usr, msg, str, num_str As String

		msg = ""
		For i = 1 To UBound(data_list)
			str = data_list(i)
			num_str = CStr(i)
			If Len(num_str) = 1 Then num_str = " " + num_str

			If msg <> "" Then msg = msg + vbNewLine
			msg = msg + num_str + " - " + str
		Next

		Do While True
			usr = Trim (InputBox (msg, "Select Feature Name <ESC = Cancel>"))
			If usr = "" Then
				SelectItemInputBox = False
				Exit Function
			End If

			If IsNumeric(usr) Then
				If CInt(usr) >= Lbound(data_list) And _
				   CInt(usr) <= Ubound(data_list) Then
					Exit Do
				End If
			End If
		Loop

		selected_item = data_list(CInt(usr))
		SelectItemInputBox = True
	End Function

End Class


Sub CATMain()

	Dim usr As String
	Dim data_list() As String
	Dim selected_item As String
	Dim dir_content As CustomGetDirContent

	CATIA.RefreshDisplay = False

	ReDim data_list(0)
	Set dir_content = New CustomGetDirContent

	dir_content.GetSortedDirContent CATALOG_DIR, ".CATPart", data_list
	dir_content.RemoveItemFromList data_list, "dart"

	' MsgBox _
	' 	Join(data_list, vbNewLine), vbOkOnly, _
	' 	"There are " + CStr(UBound(data_list)) + " items available:"

	If dir_content.SelectItemInputBox (data_list, selected_item) = True Then
		MsgBox "Selected feature name = " + selected_item
	Else 
		MsgBox "Nothing selected."
	End If

End Sub

' ---- read-density.CATScript
Option Explicit
Language = "VBSCRIPT"

Function IsInShownMode (ByVal Item As AnyObject) As Boolean
	Dim sel As Collection
	Dim showstate As CatVisPropertyShow
	Set sel = CATIA.ActiveDocument.Selection

	IsInShownMode = False

	sel.Clear
	sel.Add Item
 	sel.VisProperties.GetShow showstate
		
	If showstate = catVisPropertyShowAttr Then
		IsInShownMode = True
	End If
End Function

' // Read material name from part body's parameters.
' //
Function ReadMaterialNameFromParameters (
			ByRef currentPart As PartBody, ByVal currentBody As PartBody, _
			ByRef cMaterial As String) As Boolean

	Dim i As Integer
	Dim param As Parameters
	Dim Material As String

	Material = ""
	ReadMaterialNameFromParameters = False

	On Error Resume Next
	Set param = currentPart.Parameters.SubList(currentBody, False)

	If Err.Number <> 0 Then
		On Error Goto 0
		Exit Function
	End If
	
	On Error Goto 0

	If ( param.Count > 0 ) Then
		Material = param.Item(1).Value
	End If

	cMaterial = Material
	ReadMaterialNameFromParameters = True
End Function

' // example call
Sub CATMain ()

	Dim cnt As Integer
	Dim cMaterial As String
	Dim density  As Double : density = 0.0
	Dim spa      As Workbench
	Dim measure  As Measurable
	Dim refObj   As Reference
	Dim bodyInertia As Inertia
 	Dim thisPart As Part

	Set spa = CATIA.ActiveDocument.GetWorkbench("SPAWorkbench")
	Set thisPart = CATIA.ActiveDocument.Part

	For cnt = 1 To thisPart.Bodies.Count

		Dim currentBody As PartBody
		Set currentBody = thisPart.Bodies.Item(cnt)

		If ( (IsInShownMode( currentBody ) = True) AND _
			 (currentBody.InBooleanOperation = False) AND _
			 (currentBody.Shapes.Count <> 0) AND _
			 (ReadMaterialNameFromParameters(thisPart, currentBody, cMaterial) = True ) ) Then
			
			Set refObj = thisPart.CreateReferenceFromObject(currentBody)
			Set measure = spa.GetMeasurable(refObj)
			Set bodyInertia = spa.Inertias.Add(currentBody)

			density = bodyInertia.Density

			' ------------------------------------------------
			MsgBox currentBody.Name + " ---> " + CStr(density)
			' ------------------------------------------------
			
			If (density = 1000.0) Then
				' .......
			End If
		End If
	Next

End Sub

In CATIA the “Tools/Parameterization Analysis” dialog can be used to show a list of sketches which are fully-, under- or over-constrained.

With the following code snippet, a similar effect can be achieved:

Sub CATMain()

	Dim active_doc As Document
	Dim sel As Selection

	On Error Resume Next
	Set active_doc = CATIA.ActiveDocument
	On Error Goto 0

	If Err.Number <> 0 Then
		MsgBox "ERROR: Active Document must be a CATPart model."
		Exit Sub
	End If

	Set sel = active_doc.Selection

	' notes: in CATIA the "Tools/Parameterization Analysis" dialog can be used
	'        to show a list of sketches which are fully-, under- or over-constrained.

	' trials:
	' - invalid search criteria:
	'     sel.Search "'Part Design'.'Part Design'.Sketch.'Solving Status'=Inconsistent"
	' -works but of no use (?):
	'     sel.Search "CATPrtSearch.Sketch.SolvingStatus=Inconsistent,all"

	' - works:
	sel.Clear
	sel.Search "CATPrtSearch.Sketch.SolvingStatus=Underdefined,all"
End Sub

The following macro opens all 3D models (like “Edit Links” in CATIA) which are linked to a drawing document.
In this example, all attached files are opened at once.

Language="VBSCRIPT"

' // search in a given string array if str is already available
' //
Function ArrayItemExists (ByVal arr() As String, ByVal str As String) As Boolean
	Dim i As Integer
	For i = 1 TO Ubound(arr)
		If str = arr(i) Then
			ArrayItemExists = True
			Exit Function
		End If
	Next
	ArrayItemExists = False
End Function

' // the function loops through all views of a given CATDrawing
' // trying to find the associated 3D Model linked to each individual view
' // execution stops, when the 1st valid link to a physical model could be found
' // (the existence of the file is checked as well)
' // assumptions:
' //    - as we need to have a 1:1 relation between drawing and part,
' //      the given drawing document must be component drawing
' //      and no assembly drawing
' //
Function GetAllDrawingLinks (ByVal activeDoc As Document, _
							 ByRef model_links() As String) As Boolean
	Dim view As DrawingView
	Dim sheet As DrawingSheet
	Dim txt As DrawingText
	Dim firstLink As AnyObject
	Dim viewLinks As DrawingViewGenerativeLinks
	Dim fs As FileSystem

	Dim i, debug, model_cnt As Integer
	Dim cat_model_name, full_path_name As String

	debug = 0
	model_cnt = 0
	linked_part_name = ""
	GetAllDrawingLinks = False

	' loop through all sheets...
	For Each sheet In activeDoc.Sheets

		' and loop through all views...
		For Each view In sheet.Views

			' retrieve the first link of the drawing view
			Set viewLinks = view.GenerativeLinks

			Err.Clear : On Error Resume Next
			Set firstLink = viewLinks.FirstLink()

			If Err.Number <> 0 Then
				If debug = 1 Then
					Msgbox _
						view.Name + vBNewline _
						"An error occurred when trying to read drawing view link: " + vBNewline + _
						Err.Source + vbNewline + Err.Description + vbNewline + _
						"Continue ...", _
						vbExclamation + vbOKOnly, "Error:"
				End If

			Else
				' --------------------------------------------
				' attempt to read full qualified 3D model name
				' --------------------------------------------
				If debug = 1 Then
					On Error Goto 0 ' disable any error handler currently set
				End If

				' catia model name can be found in the parent object:
				cat_model_name = firstLink.Parent.Name

				If cat_model_name <> "" Then

					Set fs = CATIA.FileSystem
					full_path_name = fs.ConcatenatePaths (firstLink.Parent.Path, cat_model_name) 
					' note: firstLink.Parent.FullName() doesn't work
					' MsgBox "-->" + view.Name + " : " + full_path_name

					If fs.FileExists(full_path_name) And _
					   ArrayItemExists(model_links, full_path_name) = False Then					

						model_cnt = model_cnt + 1
						ReDim Preserve model_links(model_cnt)
						model_links(model_cnt) = full_path_name
					End If

				End If
			End If
		Next
	Next

	If model_cnt <> 0 Then
		GetAllDrawingLinks = True
	End If

End Function

Sub OpenAssociatedModel (ByVal active_doc As Document, ByVal linked_model As String)
	' open the linked part...
	Dim part_doc As PartDocument
	Set part_doc = CATIA.Documents.Open(linked_model)

End Sub

' // --------------
' // here we go ...
' // --------------
Sub CATMain()

	Dim usr, cnt, err_num As Integer
	Dim active_doc As Document
	Dim model_links() As String
	Dim linked_model, msgstr As String

	' prevent the macro to stop execution at each alert
	CATIA.RefreshDisplay = False
	CATIA.DisplayFileAlerts = False

	On Error Resume Next
	Set active_doc = CATIA.ActiveDocument
	err_num = Err.Number
	On Error Goto 0
	
	' check whether the document is a CATPart
	If err_num <> 0 Or InStr(active_doc.Name,".CATDrawing") = 0  Then 

	 	MsgBox _
			"The active document must be a CATDrawing!", _
			vbExclamation + vbOKOnly, "Error:"

		Exit Sub
	End If

	' --------------------------------------------------
	If GetAllDrawingLinks (active_doc, model_links) Then
	' --------------------------------------------------
		cnt = 0
		For i = 1 TO Ubound(model_links)
			linked_model =  Trim (model_links(i))

			If linked_model <> "" Then
				cnt = cnt + 1
				' -unused- msgstr = msgstr + vBNewline + CStr(cnt) + ".) " + linked_model

				' -------------------------------------------
				OpenAssociatedModel active_doc, linked_model
				' -------------------------------------------
			End If
		Next

	Else
		MsgBox _
			"The drawing is not linked to any space geometry!"  + vBNewline + _
			"No (valid) model links could be detected!", _
			vbExclamation + vbOKOnly, "Warning:"
	End If

End Sub

In addition to the above version which attempts to retrieve links associated with each drawing view, there is also another macro code which follows a different approch. The usage of the code is more universal, as it should work not only for drawing documents, but also for CATpart (3D) models.

Here is the alternative code:

Sub LAppend (ByRef linked_docs() As String, ByVal new_str As String)
	Dim item As String

	' no redundant entries allowed (!)
	For Each item In linked_docs
		If item = new_str Then Exit Sub
	Next

	ReDim Preserve linked_docs(UBound(linked_docs) + 1)
	linked_docs( UBound(linked_docs) ) = new_str
End Sub

Sub SaveInformationToFile (ByVal text_buffer As String)

	Dim dir, temp_dir, tmp_filename As String
	Dim Overwrite As Boolean
	Dim fs As FileSystem
	Dim f As File
	Dim fstream As CATIATextStream

	Set fs = CATIA.FileSystem
	Set dir = fs.TemporaryDirectory
	
	temp_dir = CATIA.SystemService.Environ(dir.Name)
	tmp_filename = fs.ConcatenatePaths(temp_dir, "Linked-Files-List.tmp")

	If Not fs.FileExists (tmp_filename) Then
		Overwrite = False
		Set f = fs.CreateFile (tmp_filename, Overwrite)
	Else
		Set f = fs.GetFile(tmp_filename)
	End If

	Set fstream = f.OpenAsTextStream( "ForAppending")
	fstream.Write text_buffer + vbCr
	fstream.Close
End Sub

Function GetAllDrawingLinks (ByRef linked_docs() As String) As Boolean
	Dim i, err_num As Integer
	
	Dim doc As Document
	Dim linked_doc As String
	
	Dim sti_engine As StiEngine
	Dim sti_dbitem As StiDBitem
	Dim links As StiChildren
	Dim fs As FileSystem

	' should work for all model types: CADDrawing, CATPart and CATProduct

	Set doc = CATIA.ActiveDocument
	Set sti_engine = Catia.GetItem("CAIEngine")
	Set sti_dbitem = sti_engine.GetStiDBItemFromAnyObject(doc)
	Set links = sti_dbitem.GetChildren()

	Redim linked_docs(-1)

	For i = 1 To links.Count
		Set link = links.Item(i)
		LinkTyp = links.LinkType(i)

		On Error Resume Next
		Set linked_doc = link.GetDocument
		full_path_name = linked_doc.FullName
		err_num = Err.Number
		On Error Goto 0

		' "CATLinkTypeIsComposedOf" / "CATLinkTypeDownstream"

		If err_num = 0 And _
		   links.LinkType(i) = "CATLinkTypeDownstream" And _
		   (Instr(1, full_path_name, ".CATPart", vbTextCompare) <> 0  Or _
		    Instr(1, full_path_name, ".CATProduct", vbTextCompare) <> 0) Then

			' finally validate the existence of the data file
			Set fs = CATIA.FileSystem
			If fs.FileExists(full_path_name) Then LAppend linked_docs, full_path_name
		End If
	Next

	If UBound(linked_docs) > -1 Then
		GetAllDrawingLinks = True
	Else
		GetAllDrawingLinks = False
	End If

End Function

Sub CATMain()
	Dim linked_docs() As String

	CATIA.RefreshDisplay = False

	If Not GetAllDrawingLinks (linked_docs) Then

		MsgBox _
			"There are no valid drawing links available !", _
			vbInformation + vbOkOnly, "Information:"
	Else
		' -for development-
		' SaveInformationToFile Join(linked_docs, vbCr)

		MsgBox _
			"Macro Summary:" + vbNewLine + _
			"Number of linked document(s): " + CStr(UBound(linked_docs) +1) + vbNewLine + _
			Join (linked_docs, vbNewLine), _
			vbInformation + vbOkOnly, "Information:"
	End If

End Sub