CATScript CATScript GUI - quo vadis ?

Purpose

The CATScript programming interface in CATIA offers only very limited support for graphical user interfaces. If a more sophisticated GUI is needed, it is better to use VBScript instead of CATScript…

Since I always prefer to keep things simple, I was unwilling to accept these limitations and continued searching for alternative approaches.

What do we have

With CATScript in terms of GUI support, these functions enable user interaction through basic GUI capabilities, namely MsgDlg, InputDlg.

Additionally, there is the limitation that with CATScript, it is only difficult to properly organize source files and manage them as modules or libraries, as is common in other programming languages.

Example: How to execute code stored in another file...

Note that the path to the source needs to be hard coded.

Option Explicit
Language = "VBSCRIPT"

Const PATH_NAME = "<current-directory-name-goes-here>\CATScript"
Const CUSTOM_DLG = "CustomDialogClass.CATScript"
Const DELIM = "@"

Sub CATMain()
	Dim usr As Variant
	Dim params() As Variant
	
	' if a "*" is used at the 1st place,
	' this option becomes the default one

	ReDim params(2)
	params(0) = 400
	params(1) = 500
	params(2) = _
		"The quick brown fox" + DELIM + _
		"*jumps over" 		  + DELIM + _
		"walks around"		  + DELIM + _
		"the lazy dog."

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

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

End Sub

What we would like to achieve

Our goal is to create a self-contained macro that requires no additional source code or external declaration files. However, CATScript cannot retrieve the current path of the executing macro. Due to this limitation, any reference to external source code must use a hard-coded path — precisely what we aim to avoid.

What we can do

Here is a structured overview of the approaches explored to implement a GUI for CATScript — a determined search for a clean, simple solution.

One common drawback of almost all solutions that launch an external executable from CATScript is that the client window is not managed by the window manager to stay always on top. In other words: except for Tcl/TK executables, modal dialogs are not supported. So the GUI window can easily become hidden behind the main CATIA window, while CATIA itself remains in a frozen state. This behavior is indeed quite annoying.
-- Non omnia possumus omnes. --

Usage of an External Application

A while ago, I came along with the approach to create a main CATScript caller program and an external executable (a Tcl/Tk application) to handle the GUI. Communication between the two components is achieved through a temporary interface file.
User-defined variables and settings are exchanged back and forth via this file. While this solution works reliably, it requires significant code to implement and maintain — making it far from a simple approach.

Trade-offs:

  • Programming the external GUI application (e.g., Tcl/Tk)
  • The executable introduces an additional layer of complexity
  • The path to the executable must be hard-coded in the CATScript macro
  • A transfer file is typically required (though clipboard communication would also work). In this case, the transfer file can actually be an advantage during development of the external GUI application.

MSHTA as GUI

The next approach replaces the external application with an MSHTA (Microsoft HTML Application). MSHTA supports VBScript and ActiveX, enabling file system access and the ability to write a temporary interface file back to disk.

The HTA’s functionality is driven by a temporary HTML file generated dynamically within the CATScript code. While this solution may not be aesthetically pleasing from a source code perspective, it offers a key advantage: the more complex HTA component can be developed almost independently and later seamlessly integrated into the CATScript macro.

Example: Using MSHTA as GUI

custom-dialog-class-example

The CustomDialogClass demonstrates the concept and implements a generic user dialog for CATIA.

Trade-offs:

  • The GUI is based on HTA + mshta.exe, with the HTA:Application configured to emulate “Edge” mode.

    Is mshta.exe guaranteed to be supported in the future?

    mshta.exe relies on mshta.dll, a core component of the Windows OS, so it will most likely remain supported. That said, when it comes to Microsoft, this is only an educated guess.

  • Techniques/programming languages used:

    • catscript class, HTML, CSS, javascript,
    • HTA (running in edge emulation mode), WShell
  • The dialog is highly configurable through various input arguments.

    When launched, it appears centered on the CATIA window (multi-monitor setups are fully supported).

  • Its layout can be styled with CSS, and all behavior and event handling can be implemented in JavaScript — just like any modern web application.

  • As previously noted, this is a proof-of-concept. The source code shown here can serve as a starting point for a more advanced and feature-rich user dialog.

  • Return values are passed back to the CATScript caller via the WShell stdout stream.

    The dialog remains active as long as the stream is open and does not return an EOF marker (or equivalent).

' -----------------------------------------------------------------------------
' --- CustomDialogClass.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.
' -----------------------------------------------------------------------------
' -----------------------------------------------------------------------------
'
' Purpose:
'
'   A generic user dialog for Catia.
'   This is a prove of concept and is based on HTA + mshta.exe, whereas
'   the HTA:Application is configured to emulate "Edge" mode.
'   Is it guaranteed so that mshta.exe will be supported in the future?
'   Mshta.exe depends on mshta.dll which is part of the OS and most likely
'   it will be supported. As we are speaking about MS, of course, this is
'   only a good guess.
'
'   Techniques/programming languages used:
'     catscript class, HTML, CSS, javascript,
'     HTA (running in edge emulation mode), WShell
'
'   The dialog can be configured via a variety of input arguments.
'   When calling up, the dialog window is positioned in the center
'   of the Catia screen (multi screen environment also supported).
'   The layout of the dialog can be styled via css and behavior and
'   event management can be programmed via javascript as for any web
'   application.
'   As mentioned above, this is a prove of concept and the source code
'   provided here might be a starting point for an even more elaborated
'   user dialog.
'   The return value(s) is(are) returned to the catscript caller via
'   the "wshell stdout" stream and so the dialog keeps alive as long as
'   the stdout stream does not return -eof- code (or similar).
' -----------------------------------------------------------------------------
' -----------------------------------------------------------------------------
' Option Explicit
Language="VBSCRIPT"

Class CustomDialogClass

	Private H() As String
	Private Image As String

	Private Sub Class_Initialize()
		ReDim H(0)
		Image = ""
	End Sub

	Private Sub LAdd (ByVal str As String)
		' index always starts at position 1
		ReDim Preserve H (UBound(H) + 1)
		H (UBound(H)) = str
	End Sub

	Private Property Get Count() As Long
        Count = UBound(H)
    End Property

	Private Property Get Item (ByVal index As Long) As String
        Item = H(index)
    End Property

	Private Function CreateUniqueFileName ( _
				ByVal file_name As String, _
				ByVal file_ext As String, _
				ByRef full_path_name As String) As Boolean
		Dim d,m,y, _
			date_str, time_str, temp_dir As String

		Dim str As Folder
		Dim fs As FileSystem

		' get the user's temporary directory ...
		' --------------------------------------

		Set fs = CATIA.FileSystem
		Set str = fs.TemporaryDirectory
		temp_dir = CATIA.SystemService.Environ(str.Name)

		IF Not fs.FolderExists(temp_dir) Then
			CreateUniqueFileName = False
			Exit Function
		End IF

		' create a unique time-stamp
		' --------------------------
		' note:
		' date_str = FormatDateTime(Now(), vbGeneralDate)
		' does not work very well as the function relies
		' on system default settings which might be unpredictable

		d = Day(Now())
		m = Month(Now())
		y = Right(Year(Now()), 2)
		
		If Len(d) = 1 Then d = "0" & d
		If Len(m) = 1 Then m = "0" & m

		date_str = y & "-" & m & "-" & d
		time_str = Replace (Time, ":", "-", 1, -1, vbTextCompare)
		time_stamp = Replace (date_str & "-" & time_str, " ", "-", 1, -1, vbTextCompare)

		' and finally, create a full pathname
		file_name = file_name + "-" + time_stamp + file_ext
		full_path_name = fs.ConcatenatePaths(temp_dir, file_name)

		CreateUniqueFileName = True
	End Function

	' // attempt to open a data file
	' //
	Private Function OpenDataFileForWriting ( _
				ByVal fileName As String, _
				ByRef ostream As CATIATextStream) As Boolean

		Dim Overwrite As Boolean : Overwrite = True
		Dim fs As FileSystem
		Dim f As File

		OpenDataFileForWriting = False
		Set fs = CATIA.FileSystem

		On Error Resume Next
		Set f = fs.CreateFile(fileName, Overwrite)
		On Error Goto 0

		If (Err.Number <> 0) Then
			Exit Function
		End IF

		' attempt to open the output file
		On Error Resume Next
		Set ostream = f.OpenAsTextStream( "ForWriting" )
		On Error Goto 0

		If Err.Number <> 0 Then
			Exit Function
		End If

		OpenDataFileForWriting = True
	End Function

	' no external or add on files are used
	'
	Private Sub BuildDialog ( _
					ByVal w As Long, ByVal h As Long, _
					ByVal msg As String, ByVal params() As String)

		Dim i As Integer
		Dim label, rbutton As String
		Dim left, top As Long
		Dim fs As CATIAFileSystem
		Set fs = CATIA.FileSystem

		' header block...
		LAdd "<html>"
		LAdd "<head>"
		LAdd "<title>Option Dialog</title>"
		LAdd "<hta:application"
		LAdd "  id='myHTA' applicationname='Select Option:'"
		LAdd "  border='thin' borderstyle='normal' innerborder='no'"
		LAdd "  caption='yes'"
		LAdd "  singleinstance='yes'"
		LAdd "  showintaskbar='yes'"
		LAdd "  navigable='yes'"
		LAdd "  sysmenu='no' contextmenu='no'"
		LAdd "  maximizebutton='no' minimizebutton='no'"
		LAdd "  resizable='no'>"
		LAdd "<meta http-equiv='x-ua-compatible' content='ie=edge'>"
		
		LAdd "<style>"
		LAdd "body {"
		LAdd "  padding:0; margin:0;"
		LAdd "  font-family: Arial,sans-serif; font-size:12px;"
		LAdd "}"
		LAdd ".container {"
		LAdd "  display:flex;"
		LAdd "  flex-direction:column;"
		LAdd "  align-items:center;"
		LAdd "  justify-content:center;"
		LAdd "  background-color:GhostWhite;"
		LAdd "}"
		LAdd "label {"
		LAdd "  display:block;"
		LAdd "  margin:5px;"
		LAdd "  padding:10px;"
		LAdd "  border:1px solid #ccc;"
		LAdd "  border-radius:10px;"
		LAdd "  cursor:pointer;"
		LAdd "  transition:background-color 0.2s ease;"
		LAdd "  background:GhostWhite;"
		LAdd "  min-width:200px;font-size:14px;"
		LAdd "}"
		LAdd "  label:hover {"
		LAdd "  background-color:CornflowerBlue;"
		LAdd "}"
		LAdd "button {"
		LAdd "  margin:5px;"
		LAdd "  padding:5px 5px;"
		LAdd "  border:1px solid #ccc;"
		LAdd "  border-radius:5px;"
		LAdd "  cursor:pointer;"
		LAdd "  transition:background-color 0.2s ease;"
		LAdd "  min-width:100px;"
		LAdd "}"
		LAdd "button:hover {"
		LAdd "  background-color:CornflowerBlue;"
		LAdd "}"
		LAdd "#okButton:focus, #cancelButton:focus {"
		LAdd "  outline:none;"
		LAdd "}"
		LAdd "img {"
		LAdd "  max-width:100%;"
		LAdd "  height:auto;"
		LAdd "  margin-top:5px;margin-bottom:5px;"
		LAdd "}"
		LAdd "</style>"

		LAdd "</head>"
		LAdd "<body scroll='no' style='background-color:Lavender;' >"

		' logo goes here ...
		If (fs.FileExists(Image)) Then
			LAdd "<div class='container'>"
			LAdd "<img src='" + Image + "'>"
			LAdd "</div>"
		ElseIf _
			(Len(Image) > 100) Then ' is a base64 encoded image ?
			LAdd "<div class='container'>"
			LAdd "<img src='data:image/png;base64, " + Image + " '>"
			LAdd "</div>"
		End If

		LAdd "<div class='container' style='background-image: linear-gradient(GhostWhite,Lavender);'>"

		' message goes here ...
		If (Len(msg) <> 0) Then
			LAdd "<h3>"
			LAdd msg
			LAdd "</h3>"
		End If

		LAdd "<div class='radio'>"

		' "<label id='label1' onclick='selectLabel(""label1"")' style='background-color:CornflowerBlue;'>"
		' "<input type='radio' id='myRadioButton1' name='myRadioGroup' value='Option 1' checked>"
		' "Option 1"
		' "</label>"
		' "<br/>"

		For i = 1 To Ubound(params)
			label = "label" + CStr(i)
			rbutton = "myRadioButton" + CStr(i)
			value =	Trim(params(i))
			
			If (InStr(1, value, "*", vbTextCompare)) Then
				value = Mid (value, 2, Len(value))
LAdd "<label id='" + label + "' onclick='selectLabel(""" + label + """)' style='background-color:CornflowerBlue;'>"
LAdd "<input type='radio' id='" + rbutton + "' name='myRadioGroup' value='" + value + "' checked>"
LAdd value
LAdd "</label>"
			Else
LAdd "<label id='" + label + "' onclick='selectLabel(""" + label + """)'>"
LAdd "<input type='radio' id='" + rbutton + "' name='myRadioGroup' value='" + value + "'>"
LAdd value
LAdd "</label>"
			End If

		Next

		LAdd "</div>"
		LAdd "</div>"
		LAdd "<div class='container' style='background:Gainsboro; border-radius: 0px; padding:10px;'>"
		LAdd "<div>"
		LAdd "<button id='okButton' onclick='OK_Click()'>OK</button>"
		LAdd "<button id='cancelButton' onclick='Cancel_Click()'>Cancel</button>"
		LAdd "</div>"
		LAdd "</div>"
		LAdd "<script type='text/javascript'>"

		If TypeName(CATIA) = "Application" Then

			' some screen arithmetics required to place the dialog centered
			' on-top of the CATIA window, should also work for dual screens...
		
			left = CATIA.Left + (CATIA.Width/2)-(w/2)
			top  = CATIA.Top  + (CATIA.Height/2)-(h/2)
			
			LAdd "window.resizeTo(" + CStr(w) + "," + CStr(h) + ");"
			LAdd "window.moveTo(" + CStr(left) + "," + CStr(top) + ");"
			LAdd "window.focus();"
		Else
			' fallback solution
			LAdd "const w = " + CStr(w) + ";"
			LAdd "const h = " + CStr(h) + ";"
			LAdd "window.resizeTo(w, h);"
			LAdd "window.moveTo((screen.availWidth - w) / 2, (screen.availHeight - h) / 2);"
			LAdd "window.focus();"
		End If

		LAdd "function selectLabel(labelId) {"
		LAdd "const labels = document.getElementsByTagName('label');"
		LAdd "for (let i = 0; i < labels.length; i++) {"
		LAdd "labels[i].style.backgroundColor = '';"
		LAdd "}"
		LAdd "const selectedLabel = document.getElementById(labelId);"
		LAdd "selectedLabel.style.backgroundColor = 'CornflowerBlue';"
		LAdd "}"

		class_LAdd "function OK_Click() {"
		class_LAdd "const stdout = new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1);"
		class_LAdd "var inputs = document.querySelectorAll('input[name=""myRadioGroup""]');"
		class_LAdd "var usr = 0;"
		class_LAdd "for (var i = 0; i < inputs.length; ++i) {"
		class_LAdd "if (inputs[i].checked) {"
		class_LAdd "usr = i+1;"
		class_LAdd "break;"
		class_LAdd "}"
		class_LAdd "}"
		class_LAdd "if (usr === 0) {"
		class_LAdd "stdout.WriteLine('');"
		class_LAdd "} else {"
		class_LAdd "stdout.WriteLine(usr);"
		class_LAdd "}"
		class_LAdd "window.close(1);"
		class_LAdd "}"

		LAdd "function Cancel_Click() {"
		LAdd "window.close();"
		LAdd "}"
		LAdd "document.addEventListener('keydown', function(event) {"
		LAdd "if (event.key === 'Enter') {"
		LAdd "event.preventDefault();"
		LAdd "document.getElementById('okButton').click();"
		LAdd "}"
		LAdd "event = window.event;"
		LAdd "if (event.keyCode == 27) {"
		LAdd "event.preventDefault();"
		LAdd "document.getElementById('cancelButton').click();"
		LAdd "}"
		LAdd "});"
		LAdd "</script>"
		LAdd "</body>"
	End Sub

	Public Sub SetImage (ByVal mmencoded_str As string) As String
        Image = mmencoded_str
    End Sub

	Public Function ShowSelectionDialog ( _
			ByVal w As Long, ByVal h As Long, _
			ByVal msg As String, ByVal params() As String) As String

		Dim usr, hta_dialog_filename As String
		Dim fs As FileSystem
		Dim ostream As CATIATextStream
		Dim wsh As IWsgShell3
		Dim hta As WshExec
	
		Set fs = CATIA.FileSystem

		' create unique temp File
		If Not CreateUniqueFileName ("hta_dialog", ".hta", hta_dialog_filename) Then
			Err.Raise 1010, _
				"CustomDialogClass", _
				"Unable to create temporary file: " + hta_dialog_filename
		End If
		
		If Not OpenDataFileForWriting (hta_dialog_filename, ostream) Then
			Err.Raise 1011, _
				"CustomDialogClass", _
				"Unable to open file: " + hta_dialog_filename + " for writing!"
		End If

		' build dialog
		Call BuildDialog (w,h, msg, params)

		' write hta dialog information to temp file...
		For i = 1 To Count
			ostream.Write Item(i) + Chr(10)
		Next
		ostream.Close
	
		' call up the the dialog
		usr = ""

		' mshta.exe
		'   - is based on mshta.dll which is part of the windows OS and is supported
		'     for the future (whereas IE is running out of support)
		'   - no more command line options, takes a script as argument,
		'     or a HTA dialog file, when using HTA a file is required,
		'     a string which holds the hta code is not accepted (!)
		'
		Set wsh = CreateObject("WScript.Shell")
		Set hta = wsh.Exec("mshta.exe " + hta_dialog_filename)

		If hta.ExitCode <> 0 Then
			' handle error (if any)
			MsgBox "Error occured while executing mshta.exe!"
		Else
			' get the selected value from the HTA window,
			' CATIA keeps in frozen state as long as 'stdout stream'
			' does not send eof-stream...
			
			Do Until hta.StdOut.AtEndOfStream
				usr = hta.StdOut.ReadLine()
			Loop
		End If

		fs.DeleteFile (hta_dialog_filename)

		' return value
		ShowSelectionDialog = usr
	End Function

End Class

' ------------------------
' dialog test goes here...
' ------------------------

Dim MMENCODED_LOGO As String
MMENCODED_LOGO = _
"iVBORw0KGgoAAAANSUhEUgAAAPoAAAA6CAMAAACu2rS7AAAABGdBTUEAALGPC" + _
"VQAAAL3UExURUdwTP8MAP7+/87Ozujo6P///9HR0ezs7O3t7evr683Nzf+KAO" + _
"...truncated, insert your own logo here (optional) ..."

Sub LAddValue (ByRef options() As String, ByVal str As String)
	' index always starts at position 1
	ReDim Preserve options (UBound(options) + 1)
	options (UBound(options)) = str
End Sub

' example function, can be called directly from CATMain

Function CustomDialogClass_Cmd (ByVal options() As String) As String
	Dim usr As String
	Dim DLG As CustomDialogClass

	Set DLG = New CustomDialogClass
	' DLG.SetImage (MMENCODED_LOGO)

	usr = DLG.ShowSelectionDialog (_
			400, 500, "Select your required option:", options)
	
	Set DLG = Nothing

	CustomDialogClass_Cmd = usr
End Function

' example function, can be called via "CATIA.SystemService.ExecuteScript"

Function CustomDialogClass_Cmd1 ( _
			ByVal opt_w As Integer, ByVal opt_h As Integer, _
			ByVal option_str As String) As String
	Dim arr As Array
	Dim usr As String
	Dim options() As String
	Dim DLG As CustomDialogClass

	ReDim options(0)

	arr = Split(option_str, "@")
	For i = 0 To Ubound(arr)
		LAddValue options, arr(i)
	Next

	Set DLG = New CustomDialogClass
	' DLG.SetImage (MMENCODED_LOGO)
	DLG.SetImage ("<Your own path here>\job_engineering_logo_small-min.png")

	usr = DLG.ShowSelectionDialog (_
			opt_w, opt_h, "Select your required option:", options)
	
	Set DLG = Nothing

	CustomDialogClass_Cmd1 = usr
End Function


Sub CATMain ()
	Dim usr, options() As String
	' Dim catia_w, catia_h As Integer

	' if a "*" is used at the 1st place,
	' this option becomes the default one

	ReDim options(4)
	options(1) = "The quick brown fox"
	options(2) = "*jumps over" 'default option
	options(3) = "walks around"
	options(4) = "the lazy dog."

	' MsgBox CStr(catia_w) + " : " + CStr(catia_h)

	CATIA.RefreshDisplay = False

	' -----------------------------------
	usr = CustomDialogClass_Cmd (options)
	' -----------------------------------

	If (Len(usr) = 0) Then
		MsgBox "Nothing selected!"
	Else
		MsgBox "You selected: " + usr
	End If
End Sub
Note that the CustomDialogClass is also explained in more detail in a separate article, which can be found on this web-site here: CustomDialogClass

iExplorer as GUI

I also experimented with replacing MSHTA with Internet Explorer. This approach, like the earlier browser-based method, requires an HTML file stored on disk, which is passed as an input argument when launching the browser as an external application.

The solution works and enables status feedback via stdout, which can be captured using the exec command in CATScript. However, Internet Explorer supports VBScript but disables ActiveX for security reasons — limiting its capabilities compared to MSHTA.

In the meantime iExplorer ran out of support and is now deprecated anyway.

MSEdge as GUI

Finally, with Internet Explorer reaching end of support, it had to be replaced by Microsoft Edge. This transition also eliminated VBScript support — replaced by JavaScript — and ActiveX remains disabled for security reasons.

So how can the missing file-write capability be overcome?

The simplest — yet not immediately obvious — solution is to use the clipboard.
Indeed, this became the breakthrough: the clipboard serves as the communication channel, passing user interactions and dialog settings directly back to the caller — no temporary file required.

This approach seems simpler and more convenient, requiring fewer dependencies and significantly less code.
-- Quod erat demonstrandum! --

Examples

Example: Using MSEdge as GUI

The following code is a fully working example which implements a rename instance names macro. The main intention although is to illustrate the msedge call.

The interface for this application is designed primarily to give the user an overview of the changes performed by the macro. In fact, the complete product tree is visualized in the GUI in a comprehensive form, so that the user can finally decide whether to save the changes or roll them back.

Note that the product tree is rendered as an HTML page using CSS class declarations which is packed together in the Compile_TreeCSS procedure.

' -----------------------------------------------------------------------------
' -- ASS-RENAME-INSTANCE-NAMES.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"

' -- Configuration Section
Const TITLE = "RENAME INSTANCE NAMES V0.1"

Class CustomArray
	Public prev_name As String
	Public new_name As String
	Public update_flag As String ' YES, NO, HTML
End Class

' ------------------------------------------------------------------------
' // CustomMessenger
' // ---------------
' // the following member functions are implemented:
' //
' //  Add     ... add a text message String
' //  Clear   ... remove message storage
' //  ShowMessage ... creates a temporary file and opens the Notepad
' //              to show all text messages
' //              could be easily extended to show a browser window
' //              with formatted text messages
' //              once the notepad window gets closed by the user,
' //              the temporary file will be deleted automatically
' ------------------------------------------------------------------------
Class CustomMessenger

	Private msgr_msg() As String
	Private MSGR_FNAME As String
	Private MSGR_MODE  As String

	Private Sub Class_Initialize()
		ReDim msgr_msg(0)
		MSGR_FNAME = "CustomMessenger"
		MSGR_MODE  = "text" ' "html"
	End Sub

	' initialize a defined system variable

	Private Function InitSystemVariable (ByVal varname As String) As String
		Dim str As String
		str = CATIA.SystemService.Environ(varname)

		' check, if system variable is empty ...
		If Len(Trim(str)) = 0 Then
			Err.Raise 999, _
				"*** ERROR: SYSTEM VARIABLE IS MISSING ***", _
				"Missing declaration for " + varname + " system variable!"
		End If

		InitSystemVariable = str
	End Function
	
	'  check, if the user has permission to write to a given directory ...
	Private Function DirIsWriteable (ByVal dir_name As String) As Boolean

		Dim tmp_file As String
		Dim fs As FileSystem
		Set fs = CATIA.FileSystem

		tmp_file = "dummy_" _
			+ Replace (Time, ":", "", 1, -1, vbTextCompare) _
			+ ".tmp"
		tmp_file = fs.ConcatenatePaths(dir_name, tmp_file)
		
		On Error Resume Next
		fs.CreateFile tmp_file, True

		If Err.Number <> 0 Then
			DirIsWriteable = False
		Else
			fs.DeleteFile(tmp_file)
			DirIsWriteable = True
		End If

		On Error Goto 0
	End Function

	Private Function CreateUniqueFileName ( _
				ByVal default_file_name As String, _
				ByVal default_file_ext As String, _
				ByRef full_path_name As String) As Boolean

		Dim d,m,y, _
			date_str, time_str, _
			temp_dir, file_name As String

		Dim str As Folder
		Dim fs As FileSystem

		' get the user's temporary directory ...
		' --------------------------------------
		Set fs = CATIA.FileSystem

		' -disabled- eventually does not work properly:
		' Set str = fs.TemporaryDirectory
		' temp_dir = CATIA.SystemService.Environ(str.Name)

		' -new code-
		temp_dir = InitSystemVariable("TEMP")

		IF (Not (fs.FolderExists(temp_dir) And DirIsWriteable(temp_dir))) Then
		
			Msgbox _
				"Unable to identify temporary directory:" _
			+	vbNewLine +	temp_dir _
			+	vbNewLine +	vbNewLine _
			+	"Please communicate this error to the programmer or" _
			+	vbNewLine + "contact your administrator!", _
				vbExclamation + vbOkOnly, "Warning:"

			CreateUniqueFileName = False
			Exit Function
		End IF

		' create a unique time-stamp
		' --------------------------
		' note:
		' date_str = FormatDateTime(Now(), vbGeneralDate)
		' does not work very well as the function relies
		' on system default settings which might be unpredictable

		d = Day(Now())
		m = Month(Now())
		y = Right(Year(Now()), 2)
		
		If Len(d) = 1 Then d = "0" & d
		If Len(m) = 1 Then m = "0" & m

		date_str = y & "-" & m & "-" & d
		time_str = Replace (Time, ":", "-", 1, -1, vbTextCompare)
		time_stamp = Replace (date_str & "-" & time_str, " ", "-", 1, -1, vbTextCompare)

		' and finally, create a full pathname
		file_name = default_file_name + "-" + time_stamp + default_file_ext
		full_path_name = fs.ConcatenatePaths(temp_dir, file_name)

		CreateUniqueFileName = True
	End Function

	Private Sub DeleteAllPreviousLogFiles ( _
					ByVal default_file_name As String, _
					ByVal default_file_ext As String)

		Dim i As Integer
		Dim f_name As String
		Dim dir As Folder
		Dim f_list As Files
		Dim fs As FileSystem

		' get the user's temporary directory ...
		' --------------------------------------
		Set fs = CATIA.FileSystem
		temp_dir = InitSystemVariable("TEMP")

		IF (Not (fs.FolderExists(temp_dir) And DirIsWriteable(temp_dir))) Then
			Exit Sub
		End IF

		Set dir = fs.GetFolder(temp_dir)
		Set f_list = dir.Files

		' delete all matching files...
		On Error Resume Next
		For i = f_list.Count To 1 Step -1
		
			file_name = f_list.Item(i).Path
		
			If ( InStr(1, file_name, default_file_name) > 0 And _
				 InStr(1, file_name, default_file_ext) > 0) Then

				fs.DeleteFile (file_name)
			End If
		Next
		On Error Goto 0
	
	End Sub

	' // attempt to open a data file
	' //
	Private Function OpenDataFileForWriting ( _
				ByVal fileName As String, _
				ByRef ostream As CATIATextStream) As Boolean

		Dim Overwrite As Boolean : Overwrite = True
		Dim fs As FileSystem
		Dim f As File

		OpenDataFileForWriting = False
		Set fs = CATIA.FileSystem

		On Error Resume Next
		Set f = fs.CreateFile(fileName, Overwrite)
		On Error Goto 0

		If (Err.Number <> 0) Then
			Exit Function
		End IF

		' attempt to open the output file
		On Error Resume Next
		Set ostream = f.OpenAsTextStream( "ForWriting" )
		On Error Goto 0

		If Err.Number <> 0 Then
			Exit Function
		End If

		OpenDataFileForWriting = True
	End Function

	Public Sub Add (ByVal str As String)
		ReDim Preserve msgr_msg(UBound(msgr_msg) + 1)
		msgr_msg(UBound(msgr_msg)) = str
	End Sub

	Public Sub Clear ()
		ReDim msgr_msg(0)
	End Sub

	Public Sub SetMode (ByVal mode As String)
		Select Case mode
			Case "text" : MSGR_MODE = mode
			Case "html" : MSGR_MODE = mode
			Case Else
				Err.Raise vbObjectError + 1, _
					"Wrong mode specified, must be either 'text' (default) or 'html'"
		End Select
	End Sub

	' compile a scroll to top button with css and some javascript
	
	Private Function Compile_Scroll2TopCSS () As String

		Dim background_url As String ' rocket 40x40
		background_url = "background:url(data:image/png;base64," + _
"iVBORw0KGgoAAAANSUhEUgAAACgAAAAoCAYAAACM/rhtAAAABmJLR0QA/wD/AP+gvaeTAAAACXBIWXMAABJ0AAASdAH" + _
"eZh94AAAAB3RJTUUH5wcPDRE1IGQ5vAAABEdJREFUWMPNWc9LMl0YPX5Egos2ThQpUhAk7kwNxJixaNWmbcuCWrd00S" + _
"IUwj8gBFdta+ULoiC6caJFYEGLQKPciEKDtioT0Tjv4s35mnz7cvxR3wMXnHvvc+fMfc557g8NJDEskySJACDLsmFog" + _
"5IcSnG73QRAAHS73RzWuEMZJBAIEAAfHh748PBAAAwEAvxfALy9vSUARqNRdiwajRIAb29v+eMAAdDlcvGjLS4u8g+D" + _
"fhBgKBQiAFar1S6A1WqVABgKhQYCaehXxaVSifPz8xBFEYeHh6jVapp2QRCwv7+Ps7Mz3N/fw2azGb5VxUdHR6pqvyp" + _
"HR0f89hADYDAY5FcWDAYH4mJfToVCgQCYy+W+BJjL5QiAhUKB38bB5eVlNptN5HK5nvp7PB4YjUacn5/r5uE/eh1arR" + _
"YqlQqWlpY09eFwGH6/H36/H+FwWNO2tLSESqWCVqs1epFks1kC4NPTE0ny7u5OFYMkSXxbjwmAd3d3JMmnpycCYDab5" + _
"cg5mE6nO6Qn//CDFouFiqKodYqi0GKxdPVLp9OjB7i1tUWz2UyS1JGoaTabub29PXqAdrudGxsbJElRFClJ0qcKliSJ" + _
"oiiSJDc2Nmi323UD1C2SQqEAURR1c10URRQKBYxcxQAwNzcHAFhdXYUsy3h8fOzq8/j4CFmWsbq6qvEZuYoBMJlMash" + _
"vs9k0PKxWq7TZbBqRJJPJvlaUsX4/6n3I7XY7JicnIUkS3rb8atvffEYSYpLqmcNg+HdBWFhYAEkcHByoX935vbCwoP" + _
"br+LyJavghNplMagKOx+PUa/F4XPU3mUwcqoqtVivb7bYapmKxqDtUHR+SaLfbsFqtHEqIY7EYK5UKyuUyAGB6eho3N" + _
"ze6Ad7c3GBmZgYAUC6XUalUEIvFOHCIAXBvb08N1c7ODgVB0B1iQRC4u7urPu/t7fWk6v9szGQyBMDr62t14JOTE036" + _
"6NUA8OTkRH2+vr4mAGYyGfYN0OVy0efzaV4kyzIBsF6v9wyuXq8TAGVZ1tT7fL7OiVC/SBqNBhRFgcfj0dQ7HA5MTEw" + _
"gEon0zL9IJIKJiQk4HI6ujayiKGg0Gvo5eHV1RQDM5/NdM7K+vk6n09nzDDqdTq6vr3fV5/N5AuDV1RV1hziVSn3KtU" + _
"QiQQAsFotfgisWiwTARCLxKTdTqRR1L3Wd7fnl5SUURdG0zc7OAgCOj4/h9/vRbDb/OobRaEQ2m1V9ksmkpn1qakrzL" + _
"l0hfp/5R13eVqbh3iy8HYY4OTnZNTMdW1tbw/PzMy4uLvq/L+z3QN1rPgTAX79+8dvvZgwGA3VORF+zONbvzMdiMYyP" + _
"j8Nms6FWq+Hl5QWCIAAAarUaTCYTBEFAqVRCu93+uSvg98fJlZUVrqys8MPxdKDxxzAEq9frAIDX19euukFtYIBer1f" + _
"Ni+/5PDs7C6/XOzDAgdLMR9vc3CQAnJ6eDu1viN9K6g7T3mN8QAAAAABJRU5ErkJggg),no-repeat;"  + vbNewLine

		Compile_Scroll2TopCSS = _
				"<!-- scroll to top -->" _
			+	"<button onclick='topFunction()' id='myBtn' title='Go to top'></button>" _
			+	"<style>" _
			+	"#myBtn {display:none;position:fixed;bottom:20px;right:30px;z-index:99;" _
			+	"border:2px;outline:none;background-color:HoneyDew;cursor:pointer;padding:15px;" _
			+	background_url + "border-radius:15px;width:40px;height:40px;}" _
			+	"#myBtn:hover {background-color:LightBlue;}</style>" _
			+	"<script>" _
			+	"let mybutton = document.getElementById('myBtn');" _
			+	"window.onscroll = function() {scrollFunction()};" _
			+	"function scrollFunction() {" _
			+	"if (document.body.scrollTop > 20 || document.documentElement.scrollTop > 20) {" _
			+	"mybutton.style.display = 'block';" _
			+	"} else {" _
			+	"mybutton.style.display = 'none';" _
			+	"}" _
			+	"}" _
			+	"function topFunction() {" _
			+	"document.body.scrollTop = 0;" _
			+	"document.documentElement.scrollTop = 0;" _
			+	"}" _
			+	"</script>" _
			+	"<!-- scroll to top -->"

	End Function

	Private Function Compile_TreeCSS () As String
			Compile_TreeCSS = _
				"<!-- https://gist.github.com/dylancwood/7368914 -->" _
			+	"<style>" _
			+	"body {font-size: 100%;}" _
			+	"p.tree, ul.tree, ul.tree ul {list-style: none;margin: 0;padding: 0;}" _
			+	"ul.tree ul {margin-left: 1.0em;}" _
			+	".tree-intro, ul.tree li {position: relative;margin-left: 0;" _
			+	"padding-left: 1em;margin-top: 0;margin-bottom: 0;" _
			+	"border-left: 3px solid LightBlue;}" _
			+	"ul.tree li:last-child {border-left: none;}" _
			+	"ul.tree li:before {position: absolute;top: 0;left: 0;" _
			+	"width: 0.5em;height: 0.5em;vertical-align: top;" _
			+	"border-bottom: 3px solid LightBlue;content: """";" _
			+	"display: inline-block;}" _
			+	"ul.tree li:last-child:before {border-left: 3px solid LightBlue;" _
			+	"border-bottom-left-radius: 5px;}" _
			+	"</style>"
	End Function

	Private Function Compile_CSS () As String
			Compile_CSS = _
				"<style>" _
			+	"html{scroll-behavior: smooth; background-color:AliceBlue}" _
			+	"body {margin:0;height:100vh;line-height:1.4;}" _
			+	".header {position:floating;left:0;bottom:0;width:100%;" _
			+	"background-color:Lavender;text-align:center;padding:10px;}" _
			+	".section {margin:0;padding:5px 0 0 25px;}" _
			+	".footer {position:fixed;left:0;bottom:0;width:100%;" _
			+	"background-color:Lavender;text-align:center;}" _
			+	"button {background-color:LightBlue;border:1px solid #4CAF50;border-radius:15px;" _
			+	"padding:5px 20px;text-align:center;text-decoration: none;" _
			+	"display:inline-block; font-size:16px;margin:10px;}" _
			+	"button:hover {background-color:#4CAF50;color:White;}" _
			+	"</style>"
	End Function

	Private Sub Puts (ByVal ostream As CATIATextStream, ByVal str As String)
		ostream.Write str + vbNewLine
	End Sub

	Public Sub ShowMessage (ByVal mode As String, ByVal header_txt As String)
		Dim i As Integer
		Dim is_ok, wait_on_return As Boolean
		Dim usr As Variant
		Dim w, h, left, top As Long
		Dim win_pos, win_size, win_app As String
		Dim log_file, ext As String
		Dim ostream As CATIATextStream

		Select Case mode
			Case "html" : ext = ".html"
			Case Else   : ext = ".tmp"
		End Select

		Call DeleteAllPreviousLogFiles (MSGR_FNAME, ext)

		If CreateUniqueFileName (MSGR_FNAME, ext, log_file) Then

			is_ok = True
			If OpenDataFileForWriting (log_file, ostream) Then
				Dim fs As FileSystem
				Set fs = CATIA.FileSystem

				Select Case mode
					Case "html"

						' dump text as html string to temporary file...
						Puts ostream, "<!DOCTYPE html><html>"
						Puts ostream, "<head>"
						Puts ostream, "<title>Update Information:</title>"
						Puts ostream, Compile_CSS
						Puts ostream, Compile_TreeCSS
						Puts ostream, "</head>"

						Puts ostream, "<body>"
						Puts ostream, Compile_Scroll2TopCSS
						Puts ostream, "<div class='header'>"
						Puts ostream, "<strong>" + header_txt + "</strong>"
						Puts ostream, "</div>"

						Puts ostream, "<div class='section'>"
						For i = 1 To UBOUND(msgr_msg)
							Puts ostream, msgr_msg(i)
						Next
						Puts ostream, "</div>"

						Puts ostream, "<div class='footer'>"
						Puts ostream, "<button onclick='window.close();'>Close Window</button>"
						Puts ostream, "</div>"

						Puts ostream, "</body>"
						Puts ostream, "</html>"

						ostream.Close

						Dim sh As IWshShell3
						Set sh = CreateObject("Wscript.Shell")

						' some screen arithmetics required to place the dialog centered
						' on-top of the CATIA window, should also work for dual screens...
						w = 1150
						h = 650
						left = Int(CATIA.Left + (CATIA.Width/3)-(w/2))
						top  = Int(CATIA.Top  + (CATIA.Height/3)-(h/2))
						win_pos =  " --window-position=" + CStr(left) + "," + CStr(top)
						win_size = " --window-size=" + CStr(w) + "," + CStr(h)
						win_app =  " --app=" + log_file
						wait_on_return = True
						
						' wait_on_return has no effect in combination
						' with "msedge" the "Run" command immediately returns,
						' we have to make sure that the log file is not
						' immediately deleted (!)
						'--------------------------------------------------------
						sh.Run _
							"msedge.exe " + win_pos + win_size + win_app, _
							1, wait_on_return
						'--------------------------------------------------------

					Case Else

						' dump text to temporary file...
						For i = 1 To UBOUND(msgr_msg)
							Puts ostream, "  " + msgr_msg(i) + vBNewline
						Next
						ostream.Close

						' show message with Notepad ...
						'-----------------------------------------------------------
						CATIA.SystemService.ExecuteProcessus ("Notepad " + log_file)
						'-----------------------------------------------------------
				End Select

				' bug fix:
				' -works- but we use DeleteAllPreviousLogFiles subroutine instead
				' Sleep 0.8 : fs.DeleteFile (log_file)

			Else
				is_ok = False
			End If
		End If

		' use MsgBox as a fall-back ...
		If is_ok = False Then
			Dim tmp As String
			tmp = ""

			For i = 1 To UBOUND(msgr_msg)
				tmp = tmp + msgr_msg(i) + vbNewLine
			Next
			
			'-----------------------------------------------
			MsgBox tmp, vbInformation + vbOKOnly, header_txt
			'-----------------------------------------------
		End If
	End Sub

End Class

Class CustomSwitchToDesign

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

		IsInShownMode = False

		sel.Clear
		sel.Add obj
		sel.VisProperties.GetShow showstate
			
		If showstate = catVisPropertyShowAttr Then
			' MsgBox "IsInShownMode -->" + obj.Name
			IsInShownMode = True
		End If
	End Function

	' // calculate number of products,
	' // which are actually visible on screen (in show mode)
	' //
	Private Sub GetProductCount ( ByVal prod_list As Products, ByRef prod_cnt As Integer )
		Dim i As Integer
		Dim sub_products As Products

		For i = 1 to prod_list.Count
		
			' product must be in-show mode
			'MsgBox "--> " +  prod_list.Item(i).Name + " : " + CStr( IsInShownMode( prod_list.Item(i) ))
			
			If IsInShownMode (prod_list.Item(i)) Then
			
				prod_cnt = prod_cnt + 1

				If prod_list.Item(i).Products.Count > 0 Then
				
					Set sub_products = prod_list.Item(i).Products
					Call GetProductCount (sub_products, prod_cnt)

				End If
			End If
		Next

	End Sub

	' // ask the user to switch to design mode
	' //
	Public Function SwitchToDesignMode (ByVal curr_product As Product) As Boolean
		Dim usr, cnt, prod_cnt As Integer
		Dim msg As String

		prod_cnt = 0
		Call GetProductCount (curr_product.Products, prod_cnt)

		If prod_cnt < 10 Then
			usr = 1
		Else
			cnt = curr_product.Products.Count

			msg = "There are:" + vBNewline _
				+ CStr(cnt)      + vbTab + "first-level products available and " + vBNewline _
				+ CStr(prod_cnt) + vbTab + "products in total, so this may take a while."

			usr = Msgbox( _
					"About to switch current Product:" _
				+	vBNewline + vBNewline _
				+		curr_product.Name _
				+	vBNewline + vBNewline _
				+	"to Design Mode." _
				+	vBNewline + vBNewline _
				+	msg _
				+	vBNewline + vbNewLine _
				+	"Do you like to continue?", _
					vbQuestion + vbOkCancel, "Question:")
		End If

		If usr = 1 Then
			' ------------------------------------
			curr_product.ApplyWorkMode DESIGN_MODE
			' ------------------------------------

			SwitchToDesignMode = True
			Exit Function
		End If

		SwitchToDesignMode = False
	End Function

	Public Function SwitchToDesignMode_does_not_work (ByVal curr_product As Product) As Boolean
		Dim usr, cnt, prod_cnt As Integer
		Dim msg As String

		prod_cnt = 0
		Call GetProductCount (curr_product.Products, prod_cnt)

		If prod_cnt < 10 Then
			usr = 1
		Else
			cnt = curr_product.Products.Count

			msg = "There are:" + vBNewline _
				+ CStr(cnt)      + vbTab + "first-level products available and " + vBNewline _
				+ CStr(prod_cnt) + vbTab + "products in total."

			usr = Msgbox( _
					"About to rename instance names for the current Product:" _
				+	vBNewline + vBNewline _
				+		curr_product.Name _
				+	vBNewline + vBNewline _
				+	msg _
				+	vbNewLine + vBNewline _
				+	"Do you like to continue?", _
					vbQuestion + vbOkCancel, "Question:")
		End If

		If usr = 1 Then
			' DESIGN_MODE / DEFAULT_MODE
			'   default mode is a mode where the product container is loaded,
			'   it's an intermediate mode between Visualization Mode and Design Mode

			' -------------------------------------
			curr_product.ApplyWorkMode DEFAULT_MODE
			' -------------------------------------

			SwitchToDesignMode = True
			Exit Function
		End If

		SwitchToDesignMode = False
	End Function

End Class


Class CustomRenameInstanceNames

	Private Function Get_ChangedItems (ByRef change_list() As Variant)
		Dim i, upd_cnt As Integer

		upd_cnt = 0
		For i = 1 To UBound(change_list)
			If (change_list(i).update_flag = "YES") Then
				upd_cnt = upd_cnt + 1
			End If
		Next

		Get_ChangedItems = upd_cnt 
	End Function

	Private Function Get_DataCount ( ByRef change_list() As Variant)
		Dim i, cnt As Integer

		' max = CStr(UBound(change_list))
		' cannot be used as we are using a 3rd flag value as well
		cnt = 0
		For i = 1 To UBound(change_list)
			Select Case change_list(i).update_flag
			Case "YES", "NO"
				cnt = cnt + 1
			End Select
		Next

		Get_DataCount = cnt 
	End Function

	Private Sub AddDataItem ( _
			ByRef change_list() As Variant, _
			ByVal str1 As String, ByVal str2 As String, _
			ByVal update_flag As String)
			
		Dim idy As Long
		idx = UBound (change_list) + 1
		ReDim Preserve change_list(idx)

		Set change_list(idx) = New CustomArray

		change_list(idx).prev_name = str1
		change_list(idx).new_name = str2
		change_list(idx).update_flag = update_flag

	End Sub

	' exactly the same logic as below,
	' but without change_list maintenance

	Private Sub RenameInstanceNamesTempNames (ByVal curr_prod As Product)

		Dim prod As Product
		Dim part_number, new_instance_name As String
		Dim part_type As StringF<br
		Dim cnt, prod_cnt As Long
		Dim str_array() As String
		Dim i, j, k, idx As Integer

		cnt = curr_prod.Products.Count

		ReDim str_array(cnt)
		For i = 1 to cnt
			str_array(i) = ""
		Next

		prod_cnt = 0
		For i = 1 to cnt
			Set prod = curr_prod.Products.Item(i)
			prod_cnt = prod.Products.Count
			k = 0

			' rename Instance
			' ------------------
			On Error Resume Next
			' ------------------
			part_number = prod.PartNumber

			If Err.Number = 0 Then

				str_array(i) = part_number
				For j = 1 to i
					If str_array(j) = part_number Then
						k = k + 1
					End If
				Next
				new_instance_name = part_number & "." & k
				
				If StrComp(prod.Name, new_instance_name) <> 0 Then
				
					' -----------------------------------
					prod.Name = prod.Name & "*" & "." & k
					' -----------------------------------
				End If
			End If

			' -------------
			On Error Goto 0
			' -------------

			If prod.Products.Count <> 0 Then
				Call RenameInstanceNamesTempNames(prod.ReferenceProduct)
			End If
		Next

	End Sub 

	' this function requires to set the product to design mode
	Private Sub RenameInstanceNames (ByVal curr_prod As Product, ByRef change_list() As Variant)

		Dim prod As Product
		Dim part_number, new_instance_name As String
		Dim part_type As StringF<br
		Dim cnt, prod_cnt As Long
		Dim str_array() As String
		Dim i, j, k, idx As Integer

		cnt = curr_prod.Products.Count

		ReDim str_array(cnt)
		For i = 1 to cnt
			str_array(i) = ""
		Next

		prod_cnt = 0
		For i = 1 to cnt
			Set prod = curr_prod.Products.Item(i)
			prod_cnt = prod.Products.Count
			k = 0

			' rename Instance
			' ------------------
			On Error Resume Next
			' ------------------
			part_number = prod.PartNumber

			If Err.Number = 0 Then

				str_array(i) = part_number
				For j = 1 to i
					If str_array(j) = part_number Then
						k = k + 1
					End If
				Next
				new_instance_name = part_number & "." & k

				' "Product" and "Part"
				AddDataItem change_list, "<li>", "", "HTML"
				If prod_cnt <> 0 Then AddDataItem change_list, "<assy>", "", "HTML"
				
				If StrComp(prod.Name, new_instance_name) <> 0 Then
					AddDataItem change_list, _
								prod.Name, new_instance_name, "YES"
					' ---------------------------
					prod.Name = new_instance_name
					' ---------------------------
				Else
					AddDataItem change_list, _
								prod.Name, new_instance_name, "NO"
				End If

				' "part"
				If prod_cnt = 0 Then
					AddDataItem change_list, "</li>", "", "HTML"
				Else
					AddDataItem change_list, "</assy>", "", "HTML"
				End If
		
			End If
			
			' -------------
			On Error Goto 0
			' -------------

			If prod.Products.Count <> 0 Then
				AddDataItem change_list, "<ul>", "", "HTML"
				Call RenameInstanceNames(prod.ReferenceProduct, change_list)
				AddDataItem change_list, "</ul>", "", "HTML"

			End If
		Next

		If prod_cnt > 0 Then
			AddDataItem change_list, "</li>", "", "HTML"
		End If

	End Sub

	Private Sub ShowHtmlMessage_Customized ( _
				ByVal root_product As Product, ByVal change_list() As Variant)

		Dim i, idx, upd_cnt, max_cnt As Integer
		Dim MGR As CustomMessenger

		Set MGR = New CustomMessenger
		MGR.Add "<style>mark{background:LightGreen;}</style>"
		MGR.Add "<style>mark1{background:LightYellow;}</style>"
		MGR.Add "<style>assy{background:LightBlue;}</style>"

		upd_cnt = Get_ChangedItems (change_list)
		max_cnt = Get_DataCount (change_list)

		' overloading CSS style declaration
		MGR.Add "<mark1> Instance name change count: <strong>" +  CStr(upd_cnt) + "</strong></mark1>"
		MGR.Add "<br/><br/>"

		MGR.Add "<p class='tree'>" + root_product.Name + "</p>"
		MGR.Add "<ul class='tree'>"

		' <li>Assembly
		'   <ul>
		'     <li>Component-1</li>
		'     <li>Component-2</li>
		'   </ul>
		' </li>

		idx = 1
		For i = 1 To UBound(change_list)

			min = CStr(idx)
			max = CStr(max_cnt)
			If idx <= 9 Then min = "0" + min
			If max_cnt <= 9 Then max = "0" + max

			Select Case change_list(i).update_flag
			Case "YES"

				MGR.Add _
					"<small><mark>" _
				+ 		min + "/" + max + ": " _
				+	"</mark></small>" _
				+	"<strong>" _
				+		CStr(change_list(i).prev_name) + "</strong> => " _
				+	"<strong><mark>" _
				+		CStr(change_list(i).new_name) _
				+	"</mark></strong>"
				idx = idx + 1

			Case "NO"

				MGR.Add _
					"<small>" _
				+ 		min + "/" + max + ": " _
				+	"</small>" _
				+	CStr(change_list(i).prev_name) + " => " _
				+	CStr(change_list(i).new_name)
				idx = idx + 1

			Case "HTML"
				MGR.Add CStr(change_list(i).prev_name)
			Case Else
				Err.Raise 1010, _
					"CustomArray - Programmer's error!", _
					"Wrong flag specified - check your code."
			End Select

		Next

		MGR.Add "</ul>"
		MGR.Add "<br/>"

		If upd_cnt = 0 Then
			MGR.Add "<mark1>No instance names were changed, nothing more to do.</mark1>"
		Else
			MGR.Add "<mark1>Continue to save changes...</mark1>"
		End If

		MGR.Add "<br/><br/><br/><br/>" ' css workaround here...

		' --------------------------------------------------------
		MGR.ShowMessage "html", "Rename Instance - Update Status:"
		' --------------------------------------------------------
		Set MGR = Nothing

	End Sub
	
	Public Sub RenameInstanceNamesCmd (ByVal root_product As Product)

		Dim change_list() As Variant
		ReDim change_list(0)
	
		' 1st call of a similar function is required to eliminate a
		' side effect in case a instance rename operation fails due
		' to already existing instance name, (instance name sort
		' order problem, .intance.3 .intance.2 which follows after
		' would fail) ...
		' -----------------------------------------------------------
		Call RenameInstanceNamesTempNames (root_product)
		Call RenameInstanceNames (root_product, change_list)
		' -----------------------------------------------------------

		Call ShowHtmlMessage_Customized (root_product, change_list)

		' turns out that Catia.RefreshDisplay = True does not work,
		' so this seems the only way to force Catia to refresh the display
		' -works but disabled, display flashes unpleasantly -
		' CATIA.Interactive = True

		' ---------------------------
		CATIA.StartCommand "Save All"
		' ---------------------------

	End Sub

End Class


' // validate active document (if any)...

Function IsValidDocument (ByRef active_doc As Document) As Boolean

	IsValidDocument = False

	' -- CATIA.ActiveDocument might fail, if there is
	'    actually no document opened in the current CATIA session
	
	On Error Resume Next
	Set active_doc = CATIA.ActiveDocument

	If Err.Number <> 0 Then
		Msgbox _
			"There is no active Document available." _
		+	vbNewLine +	vbNewLine _
		+	"Please open a CATProduct and try again!", _
			vbExclamation + vbOkOnly, "Warning:"
	
		On Error Goto 0
		Exit Function
	End If

	On Error Goto 0

	' -- validate document type ...

	If (TypeName(active_doc) <> "ProductDocument") Then
		Msgbox _
			"Your active Document type: " + TypeName(active_doc) + vbNewLine + _
			"is not valid for this action." + vbNewLine + _
			vbNewLine + _
			"Please open a CATProduct and try again!", _
			vbExclamation + vbOkOnly, "Warning:"
		Exit Function
	End If

	IsValidDocument = True
End Function


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

	Dim active_doc As Document
	Dim root_product As Product
	Dim SD As CustomSwitchToDesign
	Dim RI As CustomRenameInstanceNames
	
	CATIA.RefreshDisplay = False

	' validate and get active document...
	If Not IsValidDocument(active_doc) Then
		Exit Sub
	End If

	' -- specify the root product
	Set root_product = active_doc.Product
	Set SD = New CustomSwitchToDesign

	' -- switch the whole product to design mode
	If SD.SwitchToDesignMode (root_product) Then

		Set RI = New CustomRenameInstanceNames
		' -------------------------------------------
		Call RI.RenameInstanceNamesCmd (root_product)
		' -------------------------------------------
		Set RI = Nothing

	End If

	Set SD = Nothing
End Sub
Example: Using MSEdge as GUI + clipboard

The following code is an example which implements a drawing table editor. The main intention although is to illustrate the MSEdge call and how to use the clipboard. This way data transfer can be managed between the GUI client and back to the main macro.

This macro is a test version and may serve as a useful starting point for developing your own user dialog using the technique presented here.
It is not recommended for direct use in production.

' -----------------------------------------------------------------------------
' --- DrawingTableEditor.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.
' -----------------------------------------------------------------------------
' Purpose:
'   Allows to edit a drawing table in CATIA.
'
' Prerequisites:
'   The GUI portion of this script is based on MSEdge.
'   Make sure there is no restriction for MSEdge to allow JavaScript
'   and furthermore to allow JavaScript to write to the Windows Clipboard.
'   Usually all the above requirements are meant to be "system defaults".
'
' Technical notes:
'   When calling up MSEdge from within a "WScript.Shell" object,
'   ActiveX cannot be used (file read/write functionality is not provided),
'   this would only be possible to use for HTA ("mshta.exe") applications.
'   A workaround for this restriction is to use the clipboard
'   instead of an interface file, which, for the moment, works fine.
' -------------------------------------------------------------------------
' -------------------------------------------------------------------------
Option Explicit
Language = "VBSCRIPT"

Const TITLE = "Drawing Table Editor - testversion"
Const INTERFACE_FILENAME = "TableEditor-Interface-file.tmp"
Const CANCEL_BUTTON = "CANCEL_BUTTON_PRESSED"
Const TBL_DELIMITER = "|"

' -------------------------------------------------------------------------
' -Claxx declaration-
'   The following naming convention is used here:
'   CamelCase with lowercase first letter for private, uppercase for public
' -------------------------------------------------------------------------

Class CustomDrawingTableEditor

	Private MSGR_FNAME As String
	Private MSGR_FNAME_EXT As String

	Private Sub class_Initialize()
		MSGR_FNAME = "CustomDrawingTableEditor"
		MSGR_FNAME_EXT = ".html"
	End Sub

	Private Function createUniqueFileName ( _
				ByVal temp_dir As String, _
				ByRef full_path_name As String) As Boolean
		Dim d,m,y, _
			date_str, time_str, time_stamp, _
			file_name As String

		Dim str As Folder
		Dim fs As FileSystem

		' get the user's temporary directory ...
		' --------------------------------------
		Set fs = CATIA.FileSystem

		IF Not fs.FolderExists(temp_dir) Then
		
			Msgbox _
				"Unable to identify temporary directory:" _
			+	vbNewLine +	temp_dir _
			+	vbNewLine +	vbNewLine _
			+	"Please communicate this error to the programmer or" _
			+	vbNewLine + "contact your administrator!", _
				vbExclamation + vbOkOnly, "Warning:"

			createUniqueFileName = False
			Exit Function
		End IF

		' create a unique time-stamp
		' --------------------------
		' note:
		' date_str = FormatDateTime(Now(), vbGeneralDate)
		' does not work very well as the function relies
		' on system default settings which might be unpredictable
		d = Day(Now())
		m = Month(Now())
		y = Right(Year(Now()), 2)
		
		If Len(d) = 1 Then d = "0" & d
		If Len(m) = 1 Then m = "0" & m

		date_str = y & "-" & m & "-" & d
		time_str = Replace (Time, ":", "-", 1, -1, vbTextCompare)
		time_stamp = Replace (date_str & "-" & time_str, " ", "-", 1, -1, vbTextCompare)

		' and finally, create a full pathname
		file_name = MSGR_FNAME + "-" + time_stamp + MSGR_FNAME_EXT
		full_path_name = fs.ConcatenatePaths(temp_dir, file_name)

		createUniqueFileName = True
	End Function

	Private Sub deleteAllPreviousLogFiles (ByVal temp_dir As String)
		Dim i As Integer
		Dim f_name As String
		Dim dir As Folder
		Dim f_list As Files
		Dim fs As FileSystem

		' get the user's temporary directory ...
		' --------------------------------------
		Set fs = CATIA.FileSystem

		IF Not fs.FolderExists(temp_dir) Then Exit Sub

		Set dir = fs.GetFolder(temp_dir)
		Set f_list = dir.Files

		' delete all matching files...
		On Error Resume Next
		For i = f_list.Count To 1 Step -1
			f_name = f_list.Item(i).Path
		
			If ( InStr(1, f_name, MSGR_FNAME) > 0 And _
				 InStr(1, f_name, MSGR_FNAME_EXT) > 0) Then
				fs.DeleteFile (f_name)
			End If
		Next
		On Error Goto 0
	
	End Sub

	' // attempt to open a data file
	' //
	Private Function openDataFileForWriting ( _
							ByVal fileName As String, _
							ByRef ostream As CATIATextStream) As Boolean

		Dim Overwrite As Boolean : Overwrite = True
		Dim fs As FileSystem
		Dim f As File

		openDataFileForWriting = False
		Set fs = CATIA.FileSystem

		On Error Resume Next
		Set f = fs.CreateFile (fileName, Overwrite)
		On Error Goto 0

		If Err.Number <> 0 Then
			Exit Function
		End IF

		' attempt to open the output file
		On Error Resume Next
		Set ostream = f.OpenAsTextStream ("ForWriting")
		On Error Goto 0

		If Err.Number <> 0 Then
			Exit Function
		End If

		openDataFileForWriting = True
	End Function

	Private Function compile_CSS () As String
		compile_CSS = Join (Array (_
		"<style>",_
			"body {font-family:Arial,sans-serif;padding:20px;max-width:1200px; margin:auto;font-size:12px;}",_
			"table {border-collapse:collapse;width:100%;margin-bottom:20px;}",_
			"th, td {border:1px solid #ccc;padding:8px;text-align:left;}",_
			"td[contenteditable] {background-color:#f9f9f9;}",_
			".drag-handle {cursor:move;text-align:center;width:30px;}",_
			".dialog-buttons {text-align:center;}",_
			"button {margin:5px;padding:6px 12px;font-size:12px;border-radius:5px; border:1px solid #ccc;}",_
			"button:hover {background-color:LightGrey;}",_
		"</style>"), vbNewLine)
	End Function

	Private Function compile_JScript () As String
		' note that no comments using "//" are allowed here
		compile_JScript = Join (Array (_
		"<script>",_
			"let draggedRow = null;",_
			"document.querySelectorAll('#editableTable tbody tr').forEach(row => {",_
			"  row.addEventListener('dragstart', function () {",_
			"    draggedRow = this;",_
			"  });",_
			"  row.addEventListener('dragover', function (e) {",_
			"    e.preventDefault();",_
			"  });",_
			"  row.addEventListener('drop', function () {",_
			"    if (draggedRow !== this) {",_
			"      const tbody = this.parentNode;",_
			"      const rows = Array.from(tbody.children);",_
			"      const draggedIndex = rows.indexOf(draggedRow);",_
			"      const targetIndex = rows.indexOf(this);",_
			"      if (draggedIndex < targetIndex) {",_
			"        tbody.insertBefore(draggedRow, this.nextSibling);",_
			"      } else {",_
			"        tbody.insertBefore(draggedRow, this);",_
			"      }",_
			"      draggedRow.style.fontWeight = 'bold';",_
			"    }",_
			"  });",_
			"});",_
			"async function copyTableToClipboard() {",_
			"  const table = document.getElementById('editableTable');",_
			"  let text = '';",_
			"  for (let row of table.rows) {",_
			"    let rowText = [];",_
			"    for (let cell of row.cells) {",_
			"      if (cell.cellIndex > 0) {",_
			"        rowText.push(cell.innerText.trim());",_
			"      }",_
			"    }",_
			"    if (rowText.length > 0) {",_
			"      text += rowText.join('" + TBL_DELIMITER + "') + '\n';",_
			"    }",_
			"  }",_
			"  try {",_
			"    await navigator.clipboard.writeText(text);",_
			"    /* alert('Table content copied to clipboard.'); */",_
			"  } catch (err) {",_
			"    alert('Clipboard copy failed: ' + err);",_
			"  }",_
			"  window.close();",_
			"}",_
			"async function cancel_Click() {",_
			"  try {",_
			"    await navigator.clipboard.writeText('" + CANCEL_BUTTON + "');",_
			"  } catch (err) {",_
			"    alert('Clipboard copy failed: ' + err);",_
			"  }",_
			"  window.close();",_
			"}",_
			"function placeCursorAtEnd(el) {",_
			"  const range = document.createRange();",_
			"  const sel = window.getSelection();",_
			"  range.selectNodeContents(el);",_
			"  /* range.collapse(false); */",_
			"  sel.removeAllRanges();",_
			"  sel.addRange(range);",_
			"}",_
			"document.querySelectorAll('#editableTable td[contenteditable=""true""]').forEach(cell => {",_
			"  cell.addEventListener('keydown', function(e) {",_
			"    const currentCell = e.target;",_
			"    const currentRow = currentCell.parentElement;",_
			"    const cellIndex = Array.from(currentRow.children).indexOf(currentCell);",_
			"    let targetCell = null;",_
			"    if (e.key === 'Enter' || e.key === 'ArrowDown') {",_
			"      e.preventDefault();",_
			"      const nextRow = currentRow.nextElementSibling;",_
			"      if (nextRow) {",_
			"        targetCell = nextRow.children[cellIndex];",_
			"      }",_
			"    } else if (e.key === 'ArrowUp') {",_
			"      e.preventDefault();",_
			"      const prevRow = currentRow.previousElementSibling;",_
			"      if (prevRow) {",_
			"        targetCell = prevRow.children[cellIndex];",_
			"      }",_
			"    } else if (e.key === 'ArrowLeft') {",_
			"      e.preventDefault();",_
			"      if (cellIndex > 0) {",_
			"        targetCell = currentRow.children[cellIndex - 1];",_
			"      }",_
			"    } else if (e.key === 'ArrowRight') {",_
			"      e.preventDefault();",_
			"      if (cellIndex < currentRow.children.length - 1) {",_
			"        targetCell = currentRow.children[cellIndex + 1];",_
			"      }",_
			"    } else if (e.key === 'Escape') {",_
			"        const selection = window.getSelection();",_
			"        if (selection && !selection.isCollapsed) {",_
			"          selection.removeAllRanges();",_
			"        } else {",_
			"            const leave = confirm('Do you want to leave the app?');",_
			"            if (leave) { window.close(); }",_
			"        }",_
			"    }",_
			"    if (targetCell && targetCell.isContentEditable) {",_
			"      targetCell.focus();",_
			"      placeCursorAtEnd(targetCell);",_
			"    }",_
			"  });",_
			"});",_
		"</script>"), vbNewLine)
	End Function

	Private Sub putStr (ByVal ostream As CATIATextStream, ByVal str As String)
		ostream.Write str + vbNewLine
	End Sub

	Private Sub sleepCmd (ByVal sec As Integer)
		Dim start_time, stop_time As Single
		start_time = Timer
		Do
			stop_time = Timer
		Loop Until stop_time - start_time > sec
	End Sub

	Private Sub killNamedProcess (ByVal program_name As String)
	
		' https://stackoverflow.com/questions/47644548/
		'   vbscript-get-process-id-by-process-name-or-program-executable-name
		Dim WMIService
		Dim pitems
		Dim pitem

		Set WMIService = GetObject("winmgmts:\\.\root\cimv2")
		Set pitems = WMIService.ExecQuery( _
						"Select * From Win32_Process where name='" + program_name + "'")

		For Each pitem In pitems
			' MsgBox pitem.name & " : " & pitem.ProcessID ' & " " & pitem.CommandLine
			If Lcase(pitem.name) = program_name Then
				On Error Resume Next
				pitem.terminate
				On Error Goto 0
			End If
		Next
	
	End Sub

	Public Sub Show_DrawingTableEditor ( _
		ByVal temp_dir As String, ByVal interface_file As String)

		Dim i As Integer
		Dim wait_on_return As Boolean
		Dim usr As Variant
		Dim w, h, left, top As Long
		Dim win_pos, win_size, win_app As String
		Dim log_file, row As String
		Dim table_items As Array
		Dim istream, ostream As CATIATextStream
		Dim fs As FileSystem
		Dim f As File

		Set fs = CATIA.FileSystem

		Call deleteAllPreviousLogFiles (temp_dir)

		If (Not createUniqueFileName (temp_dir, log_file) Or _
			Not openDataFileForWriting (log_file, ostream))	Then
		
			MsgBox _
				"Arr..., something went wrong..." + vbNewLine + _
				"Cannot create log file: " + log_file,_
				vbInformation + vbOKOnly, TITLE
			Exit Sub
		End If

		' open interface file this time for reading ...
		Set f = fs.GetFile(interface_file)
		Set istream = f.OpenAsTextStream("ForReading")

		' dump text as html string to temporary file...
		putStr ostream, "<!DOCTYPE html><html lang='en'>"
		putStr ostream, "<head>"
		putStr ostream, "<meta charset='UTF-8'>"
		putStr ostream, "<title>" + TITLE + "</title>"
		putStr ostream, compile_CSS
		putStr ostream, "</head>"

		' ------------------------
		' data table goes here ...
		' ------------------------
		row = Trim(istream.ReadLine)
		table_items = Split (row, TBL_DELIMITER,-1,1)

		putStr ostream, "<table id='editableTable'>"
		putStr ostream, "<thead>"
		putStr ostream, "<tr>"
		putStr ostream, "<th></th>"

		For i = 0 To UBound (table_items)
			putStr ostream, "<th>" + table_items(i) + " </th>"
		Next

		putStr ostream, "</tr>"
		putStr ostream, "</thead>"
		putStr ostream, "<tbody>"
	
		Do Until istream.AtEndOfStream
			row = Trim(istream.ReadLine)

			If row <> "" Then
				table_items = Split (row, TBL_DELIMITER,-1,1)

				If table_items(0) = "POS" Then
					putStr ostream, "<tr> <td></td>"
				Else
					putStr ostream, "<tr draggable='true'> <td class='drag-handle'>=</td>"
				End If

				For i = 0 To UBound (table_items)
					If i = 0 Then
						putStr ostream, "<td contenteditable='true' style='width:2em;'>" + table_items(i) + "</td>"
					Else
						putStr ostream, "<td contenteditable='true'>" + table_items(i) + "</td>"
					End If
				Next

				putStr ostream, "</tr>"
			End If
		Loop

		putStr ostream, "</tbody>"
		putStr ostream, "</table>"

		putStr ostream, "<div class='dialog-buttons'>"
		putStr ostream, "  <button style='border:1.5px solid Green;' onclick='copyTableToClipboard()'>OK</button>"
		putStr ostream, "  <button style='border:1.5px solid DarkRed;' onclick='cancel_Click()'>Cancel</button>"
		putStr ostream, "</div>"

		putStr ostream, compile_JScript

		putStr ostream, "</body>"
		putStr ostream, "</html>"

		istream.Close()
		ostream.Close()

		Dim sh As IWshShell3
		Set sh = CreateObject("Wscript.Shell")

		' some screen arithmetic's required to place the dialog centered
		' on-top of the CATIA window, should also work for dual screens...
		w = 1150
		h = 650
		left = Int(CATIA.Left + (CATIA.Width/3)-(w/2))
		top  = Int(CATIA.Top  + (CATIA.Height/3)-(h/2))
		win_pos =  " --window-position=" + CStr(left) + "," + CStr(top)
		win_size = " --window-size=" + CStr(w) + "," + CStr(h)
		win_app =  " --app=" + log_file
		wait_on_return = True

		' wait_on_return has no effect in combination
		' with "MSEdge" the "Run" command immediately returns,
		' we have to make sure that the log file is not
		' immediately deleted (!)
		'---------------------------------------------------------------------
		' calling up the following command terminates **all**
		' pending MSEdge processes, as aside effect
		' "wait on return" seems to work again (!?)...
		'---------------------------------------------------------------------
		Call killNamedProcess ("msedge.exe")
		'---------------------------------------------------------------------
		sh.Run "msedge.exe " + win_pos + win_size + win_app, 1, wait_on_return
		'---------------------------------------------------------------------

		' -- and finally clean the temporary file from disk
		If fs.FileExists (log_file) Then fs.DeleteFile(log_file)

	End Sub

End Class

Function IsDrawing () As Boolean
	Dim doc As Document
	IsDrawing = False

	On Error Resume Next

	' retrieve the active document (if any)
	Set doc = CATIA.ActiveDocument

	If Err.Number <> 0 Then
		MsgBox _
			"No valid document opened!" + vbNewLine + vbNewLine + _
			"Open a drawing document and try again.", _
			vbOkOnly & vbExclamation, TITLE + " - Warning Message:"
	Else
		If TypeName(doc) = "DrawingDocument" Then
			IsDrawing = True
		Else
			MsgBox _
				"You can use this macro only for drawing documents!" + vbNewLine + vbNewLine + _
				"Open a drawing document and try again.", _
				vbOkOnly & vbExclamation, TITLE + " - Warning Message:"
		End If
	End If

	On Error Goto 0
End Function

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

	' check, if system variable is empty ...
	If Len(Trim(str)) = 0 Then
		Err.Raise 9999, _
			"ERROR: EMPTY SYSTEM VARIABLE", _
			"Missing declaration for " + varname + " system variable!"
	End If

	InitSystemVariable = str
End Function

Function CreateDataFile (ByVal if_file As String, _
                         ByRef ostream As CATIATextStream) As Boolean

	Dim Overwrite As Boolean
	Dim fs As FileSystem
	Dim f As File

	' create the output file
	Overwrite  = True
	Set fs = CATIA.FileSystem
	Set f = fs.CreateFile(if_file, Overwrite)

	On Error Resume Next

	If Err.Number <> 0 Then
		MsgBox _
			"Cannot create file:" + vbNewLine _
		+	" " + if_file + vBNewline _
		+	"Exit now!", _
			vbExclamation + vbOKOnly, TITLE + " - Error:"

		On Error Goto 0
		CreateDataFile = False
		Exit Function
	End If
	
	On Error Resume Next

	' open the output file
	Set ostream = f.OpenAsTextStream ("ForWriting")

	If Err.Number <> 0 Then
		MsgBox _
			"Cannot open file for writing:" + vbNewLine _
		+	" " + if_file +vbNewLine _
		+	"Exit now!", _
			vbExclamation + vbOKOnly, TITLE + " - Error:"

		On Error Goto 0
		CreateDataFile = False
		Exit Function
	End If

	On Error Goto 0
	CreateDataFile = True
End Function

Function SelectDrawingTable (ByRef tbl As DrawingTable) As Boolean

	Dim sel As Collection
	Dim cselFilter() As String
	Dim cout As String

	' required selection filter is:
	ReDim cselFilter(0)
	cselFilter(0) = "DrawingTable"

	Set sel = CATIA.ActiveDocument.Selection
	sel.Clear

	' perform user selection
	' error handling prevents nasty message box,
	' which appears, if the user does something else...

	On Error Resume Next
	' analysing the output state after the selection
	cout = sel.SelectElement2 (cselFilter, "Select Drawing Table:", 0)

	If Err.Number <> 0 Then
		SelectDrawingTable = False
	End If

	On Error Goto 0

	If cout = "Normal" Then
		Set tbl = sel.Item(1).Value
		SelectDrawingTable = True
	Else
		' when using a selection filter,
		' this code block is never reached ...
		MsgBox _
			"Error: Invalid selection!" + vbNewLine + _
			"Please select drawing table object and try again!", _
			vBOKOnly + vbExclamation, TITLE + " - User Warning:"

		SelectDrawingTable = False
	End If

	sel.Clear
End Function

Function Get_DwgTableText (ByVal tbl As DrawingTable, _
                           ByRef ostream As CATIATextStream) As Boolean
	Dim j,k       As Integer
	Dim ncol,nrow As Integer
	Dim txt       As String
	Dim dwgtxt    As DrawingText 

	' save time when executing a macro
	tbl.ComputeMode = CatTableComputeOFF

	ncol = tbl.NumberOfColumns
	nrow = tbl.NumberOfRows

	On Error Resume Next

	For j = 1 to nrow
		For k = 1 to ncol
			Set dwgtxt = tbl.GetCellObject(j,k)
			txt = dwgtxt.Text    

			' bug fix:
			' text string might contain newline's (multi-line text)
			' which will breaks our transfer file format
			' so all newline char's will be removed:

			' without real effect:
			txt = Replace (txt, vbNewLine, " ", 1,-1,vbTextCompare)
			txt = Replace (txt, vbCrLf,    " ", 1,-1,vbTextCompare)
			' but this statement seems to work:
			txt = Replace (txt, vbLf, " ", 1,-1, vbTextCompare)

			If k = 1 Then
				ostream.Write txt
			Else
				ostream.Write TBL_DELIMITER + txt
			End If
		Next
		ostream.Write vbLf ' previously used: vbNewLine
	Next

	tbl.ComputeMode = CatTableComputeON

	If Err.Number <> 0 Then
		Get_DwgTableText = False
	Else
		Get_DwgTableText = True
	End If

	On Error Goto 0
End Function

Function GetClipboardText() As String
	Dim str As String
	Dim html As HtmlDocument
	Set html = CreateObject("htmlfile")
	str = html.ParentWindow.ClipboardData.GetData("text")
	Set html = Nothing
	
	If TypeName(str) = "Null" Then
		GetClipboardText = ""
	Else
		GetClipboardText = Trim(str)
	End If
End Function

Function UpdateDwgTable ( _
			ByVal tbl As DrawingTable, ByVal txt As String) As Boolean

	Dim cnt,ncol,nrow As Integer
	Dim j,k, arrcnt As Integer
	Dim tbl_items, arr As Array

	If Len(Trim(txt)) = 0 Then
		MsgBox "ERROR: Clipboard is empty!", vbOkOnly
		UpdateDwgTable = False
		Exit Function
	End If

	tbl.ComputeMode = CatTableComputeOFF
	ncol = tbl.NumberOfColumns
	nrow = tbl.NumberOfRows
	tbl_items = Split (txt, vbNewLine, -1,1)
	cnt = 0
	
	For j = 1 to nrow
		arr = Split (tbl_items(cnt), TBL_DELIMITER, -1, 1)
		arrcnt = 0

		For k = 1 To ncol
			tbl.SetCellString j, k, arr(arrcnt)
			arrcnt = arrcnt + 1
		Next
		cnt = cnt + 1
	Next

	tbl.ComputeMode = CatTableComputeON
	UpdateDwgTable = True
End Function

' -------------------------------
' macro execution starts here...
' -------------------------------
Sub CATMain ()
	Dim usr As Integer
	Dim temp_dir, interface_file, txt As String

	Dim ostream As CATIATextStream
	Dim fs As FileSystem
	Dim tbl As DrawingTable

	CATIA.StatusBar = "Executing: " + TITLE

	' eventually speed up macro execution,
	' prevent to stop the macro at each file alert
	CATIA.RefreshDisplay = False
	CATIA.DisplayFileAlerts = False

	' --  validate current model and select drawing table
	If Not IsDrawing() Then Exit Sub
	If Not SelectDrawingTable (tbl) Then Exit Sub

	Set fs = CATIA.FileSystem
	temp_dir = InitSystemVariable("TEMP")
	interface_file = fs.ConcatenatePaths(temp_dir, INTERFACE_FILENAME)

	' -- create interface file
	If Not CreateDataFile (interface_file, ostream) Then Exit Sub

	' ----------------------------------
	Call Get_DwgTableText (tbl, ostream)
	' ----------------------------------
	ostream.Close

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

	Dim GUI As CustomDrawingTableEditor
	set GUI = New CustomDrawingTableEditor
	' ---------------------------------------------------------
	Call GUI.Show_DrawingTableEditor (temp_dir, interface_file)
	' ---------------------------------------------------------

	' we can clean the interface file from disk
	If fs.FileExists (interface_file) Then fs.DeleteFile(interface_file)
	
	' return value is communicated via the clipboard:
	txt = GetClipboardText()
	If txt = CANCEL_BUTTON Then Exit Sub

	' -- take the clipboard content into account
	'    and write back changes to the drawing table object
	Call UpdateDwgTable (tbl, txt)

	' MsgBox "Macro successfully ended."
End Sub