CATScript OOP programming
Object-oriented programming (OOP) is not so frequently used for CATScript macros.
This is why I’d like to present some code for a generic OOP class here mainly
to see how it looks like and what the benefits and possible drawbacks are.
The code might be useful as a starting point or to study the
structure of how a OOP class in CATscript might be organized.
CustomMessenger Class - a practical example
Here is a practical example for a class declaration, capable to collect messages on the fly during macro execution.
The class is declared and initialized at global scope and thus is accessible anywhere, almost like an internal API procedure.
The idea is to avoid the usage of “MsgBox” as much as possible during development state of a program.
Message strings are compiled on the fly where required and stored in a string array. Later on the whole bunch of information can be shown all at once. This usually is most convenient when a certain program stage is reached or at the end of the CATMain loop, e.g. to present a result window.
The class implementation simply might look like:
Class CustomMessenger
...
End Class
Public MGR As CustomMessenger
Set MGR = New CustomMessenger
...
MGR.Add "Hello World"
MGR.Add "Custom message test"
MGR.Add "Custom message test multi-line 1"
MGR.Add "Custom message test multi-line 2"
...
MGR.ShowMsg "User Information:"
“It looks pretty simple. We do not need a complex class declaration, do we?”
The answer I would like to give is yes, we do need it because of all the challenges that come with displaying messages on the screen without using “MsgBox” (messages that exceed a certain string length are truncated), implementing a function that can output both text and HTML, and completely encapsulating string array handling in the class without needing a public variable declaration, among other things.
Interface
The CustomMessage class for the moment only has 3 public methods, the rest of the functionality is private and not from interest for the “front end” programmer.
' // CustomMessenger Class:
' //
' // Add ... add a text message String
' // Clear ... remove message storage
' // ShowMsg ... creates a temporary file and opens the Notepad
' // to show all text messages
Notes
Funny enough, with OOP in theory there are 2 programmers:
- the “back end” programmer (or however you might call him) is the one who takes care about the class implementation or “black box” functionality
- and the “front end” programmer who implements a real world application who just blindly relies on the “black box”…
Implementation
Note that the ‘html’ option is experimental, and for the moment, I have only tested the ’text’ output mode. The HTML output would require a bit more logic, such as a tiny CSS framework (like min.css) for the visual appearance and some logic to automatically convert text into HTML (for example, converting a markdown-like text message to HTML).
' ------------------------------------------------------------------------
' // CustomMessenger
' // ---------------
' // the following member functions are implemented:
' //
' // Add ... add a text message String
' // Clear ... remove message storage
' // ShowMsg ... 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
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
Err.Clear : 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
Err.Clear : 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
Public Sub ShowMsg (ByVal txt As String)
Dim i As Integer
Dim is_ok As Boolean
Dim log_file, ext As String
Dim ostream As CATIATextStream
Select Case msgr_mode
Case "html" : ext = ".html"
Case Else : ext = ".tmp"
End Select
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
' dump text to a temporary file...
For i = 1 To UBOUND(msgr_msg)
ostream.Write " " + msgr_msg(i) + vBNewline
Next
ostream.Close
Select Case msgr_mode
Case "html"
Dim sh As IWshShell3
Set sh = CreateObject("Wscript.Shell")
'--window-position=50,50
' sh.Run "iexplore.exe " + log_file
sh.Run "msedge.exe --window-size=800x400 --app=" + log_file, 1, True
Case Else
' show message with Notepad ...
'-----------------------------------------------------------
CATIA.SystemService.ExecuteProcessus ("Notepad " + log_file)
'-----------------------------------------------------------
End Select
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, txt
'----------------------------------------
End If
End Sub
End Class
' initialize the class in global scope,
' so that it is accessible everywhere
Public MGR As CustomMessenger : Set MGR = New CustomMessenger
' ------------------------------------------------------------------------
' // eof CustomMessenger
' ------------------------------------------------------------------------
Example Usage
Sub Dummy ()
MGR.Add "Hello World"
MGR.Add "Custom message test"
MGR.Add "Custom message test multi-line 1"
MGR.Add "Custom message test multi-line 2"
MGR.Add "Custom message test multi-line 3"
MGR.Add "Custom message test multi-line 4"
End Sub
Sub CATMain()
Call Dummy ()
MGR.ShowMsg "User Information:"
End Sub
Support for HTML-formatted output
In the meantime the code has been extended to support HTML formatted messages as well. Some basic HTML and CSS code is used to give the output a more modern style.
' -----------------------------------------------------------------------------
' --- CustomMessengerClass.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:
'
' Revision History:
' 23-02-22, J.Oberdorfer: Initial Release
' 23-07-14, Hans, support for html output added, msedge.exe is used
' in "--app" mode to show html formatted output file.
' -----------------------------------------------------------------------------
'
' CATScript - an object oriented programming approach
'
' Object oriented programming is not commonly used for CATScript macros or at least
' I could not find much on the web or in various books and documentations.
'
' Nevertheless CATScript supports Class declarations, so there is no excuse any more
' for the adventurous programmer to go ahead.
'
' The benefits would be:
'
' + encapsulation and derivation - the beauty of code :=),
'
' + cleaner code, easier to re-use code blocks and classes,
'
' + public function could be quite similar to the CATIA API
'
' + OO programming needs a bit more thinking beforehand,
' but easier to extend and adopt later on in the course
' of the development process
'
'
' Below is an approach to create a class which can be used to collect messages
' on the fly during macro execution. The Class is declared and initialized
' at global scope and thus is accessible anywhere - with almost the same behavior
' as an internal API procedure.
'
' The idea is to try to avoid "MsgBox" calls for user interaction as much as possible,
' collect information as an array of text and present the output later on at the end
' of the CATMain loop.
'
' The class implementation simply would look like:
'
' Public MGR As CustomMessenger
' Set MGR = New CustomMessenger
'
' ```
' MGR.Add "Hello World"
' MGR.Add "Custom message test"
' MGR.Add "Custom message test multi-line 1"
' MGR.Add "Custom message test multi-line 2"
'
' MGR.ShowMessage "User Information:"
' ```
'
' Looks pretty simple. We do not need a complex class declaration, don't we?
' The answer is yes we do, because all the nasty stuff like: how do we bring the messages
' up to screen without using "MsgBox" (messages which exceeds a certain string length are truncated).
' Maybe we would like to implement a function which can output both text and html?
' String array handling can also completely encapsulated in the class and does not need a
' public variable declaration, etc....
'
' Here is the code, note that the "html" option is experimental.
' For the moment I only tested the "text" output mode.
'
' The html output would need a bit more logic:
' + tiny css framework for the visual appearance
' + and also some more logic to automatically convert text into html
' (e.g. a markdown a like text message -> html ...).
' -----------------------------------------------------------------------------
' ------------------------------------------------------------------------
' // 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)
Err.Clear : 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
Err.Clear : On Error Goto 0
End Function
Private Function DefineTempDirectory () As String
' distinguish between operating systems...
If ( Instr(1, LCase(CATIA.SystemService.Environ("OS")), "win") > 0 ) Then
DefineTempDirectory = InitSystemVariable("TEMP")
Else
DefineTempDirectory = InitSystemVariable("HOME")
End If
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 = DefineTempDirectory ()
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 = DefineTempDirectory ()
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
Err.Clear : 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
Err.Clear : 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
' initialize the class in global scope,
' so that it is accessible everywhere
Public MGR As CustomMessenger : Set MGR = New CustomMessenger
' ------------------------------------------------------------------------
' // eof CustomMessenger
' ------------------------------------------------------------------------
Sub Dummy ()
' overloading CSS style declaration
MGR.Add "<style> mark{background:LightGrey;}</style>"
MGR.Add "Hello World"
MGR.Add "<br/>Custom message test"
MGR.Add "<br/>Custom message test multi-line 1"
MGR.Add "<br/>Custom message test multi-line 2"
MGR.Add "<br/>Custom message <mark>test multi-line 3</mark>"
MGR.Add "<br/>Custom message <mark>test multi-line 4</mark>"
End Sub
Sub CATMain()
Call Dummy ()
MGR.ShowMessage "html", "User Information:"
End Sub
For education purpose only
The program was made with and is being distributed with the hope that it will be helpful.
However, the program is provided without any warranty,
without even the implied warranty of merchantability
or fitness for a particular purpose.