- Posted: 2025-11-01
- CATSCRIPT
- CAD-RELATED
- SOFTWARE
- Admin
- Time to read: 45 min.
- Word Count:
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.
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.
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.

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.
Examples
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
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
