Alert box

[paulmcz]

Is there a way to close "Alert" dialog box, without user input, in about 5 seconds after it appears on screen?

 

Thanks.

[dan20047]

Doslib provides an option, see dos_msgbox routine.

https://wiki.mcneel.com/doslib/home

 

For info w/out downloading:

https://www.afralisp.net/archive/lispa/lisp59.htm

 

[mhupp]

with doslib

(dos_msgbox "text" "title" button icon [duration])

(dos_msgbox "This Alert will disappear on hitting ok or after 10 seconds" "Alert" 1 3 10)

 

duration

The duration time in seconds. Note, duration only works with button bit values 1, 2, 3 and 5

 

https://wiki.mcneel.com/doslib/home

Edited September 27, 2021 by mhupp
dan20047 is to quick!!!

[paulmcz]

Gentlemen, thank you very much.

[BIGAL]

If the alert is a std statement then you can display a slide with a message including time delay , but there is no OK button you have to set how long it should display. I have this on 1st load of some lisps.

[Crank]

(defun MsgBox (title buttons message time / return WshShell)
;
;    Val buttons (boolean)
;    0=OKOnly     1=OKCancel   2=AbortRetryIgnore  3=YesNoCancel    4=YesNo   5=RetryCancel 6=CancelRetryContinue
;    16=Katakana  32=Question  48=Exclamation      64=Information
;   0             First button is default.
;    256             Second button is default.
;    512             Third button is default.
;    768             Fourth button is default.
;    0             Application modal; the user must respond to the message box before continuing work in the current application.
;    4096         System modal; all applications are suspended until the user responds to the message box.
;
;    Val return
;    1=OK   2=Cancel   3=Abort   4=Retry   5=Ignor   6=Yes   7=No
;
;    Time has to be a number (integer or real), if it's greater than 0, the box automaticaly closes after about
;    1+ time seconds. If it's set to 0 the box won't close until the user closes it by clicking a button.
    (setq WshShell (vlax-create-object "WScript.Shell"))
    (setq return (vlax-invoke
            WshShell
            'Popup
            message
            time
            title
            (itoa buttons)
    ))
    (vlax-release-object WshShell)
    return
)

 

Edited October 3, 2021 by Crank

[BIGAL]

If it's greater than 0, the box automatically closes after about    1+ time seconds. Not working or am I doing some thing wrong ?

[kirby]

Timeout function doesn't seem to be working, this has been a Windows problem for 10+ years

 

e.g. the following never times out

(setq Ans (msgbox "My Message" 64 "This is a message\nspanning two lines" 5))

[paulmcz]

Thanks for the code Crank but it makes unpredictable time delays. Maybe a Windows (7) problem as Kirby says?

 

(msgbox "testing time delay" 4096 "testing 10 secs" 10)

 

This has produced a time delays between 20 and 45 seconds randomly in 5 consecutive tries

[Crank]

Yes the timer is unreliable

 

What you can do:

(defun MsgBox (title options message time / WshShell)
   (setq WshShell (vlax-create-object "WScript.Shell"))
    (vlax-invoke WshShell 'Run
	 (strcat "mshta.exe vbscript:close(CreateObject(\"WScript.Shell\").Popup(\""
		  message "\"," (itoa time) ",\"" title "\"," (itoa options)"))"
         )
    )
   (vlax-release-object WshShell)
)

That always returns 0, so cannot detect which button was pressed. But this shouldn't have to be a problem when you only have one button.

Edited October 5, 2021 by Crank

[paulmcz]

Yes, this works like magic and it is very close to the time I set.

 

Thank you very much Crank.

[Crank]

You're welcome. In case you didn't notice, I've made a small correction.

[paulmcz]

I used your code from your last post and it worked well. What is your today's correction improving?

Edited October 5, 2021 by paulmcz

[BIGAL]

I can see this being a nice "You have x more goes in this trial" with say 1 second.

[Paul Li]

very nice message box with time dismissal. any way to force the message window to occur on the same screen as AutoCAD since I have multiple screens?

I know there's this function that can do it but how to implement?

(vla-get-HWND (vlax-get-Acad-Object))

(vlax-invoke WshShell 'Run

Edited March 24, 2022 by Paul Li
grammar

[marko_ribar]

I don't know if this is still relevant, but in my BricsCAD - neither one disappears when time elapsed... So it took me a while until I've cobbled this one which will do the trick, but it's somewhat convolutet, uses 3 separate tmp files and plus it brings up black blank cmd screen upon starting tmp *.bat file... But if that could be resolved in the future - this could be the correct way to overcome this issue - "time" argument version...

 

(defun MsgBox ( title buttons message time / filename1 filename2 fn li catch ret ) ;;; VBScript method ;;;

  ;Val buttons (boolean)
  ;0=OKOnly     1=OKCancel   2=AbortRetryIgnore  3=YesNoCancel    4=YesNo   5=RetryCancel 6=CancelRetryContinue
  ;16=Katakana  32=Question  48=Exclamation      64=Information
  ;0             First button is default.
  ;256             Second button is default.
  ;512             Third button is default.
  ;768             Fourth button is default.
  ;0             Application modal; the user must respond to the message box before continuing work in the current application.
  ;4096         System modal; all applications are suspended until the user responds to the message box.
  ;
  ;Val return
  ;1=OK   2=Cancel   3=Abort   4=Retry   5=Ignor   6=Yes   7=No   nil=TIME elapsed
  ;
  ;Time has to be a number (integer or real), if it's greater than 0, the box automaticaly closes after about
  ;time seconds. If it's set to 0 the box won't close until the user closes it by clicking a button.

  (setq filename1 (vl-filename-mktemp "XXXX.vbs" (getvar 'tempprefix)))
  (setq fn (open filename1 "w"))
  (write-line (strcat "strText=\"" message "\"") fn)
  (write-line (strcat "strTitle=\"" title "\"") fn)
  (write-line (strcat "intType=" (itoa buttons)) fn)
  (write-line (strcat "Set objWshShell=WScript.CreateObject(\"WScript.Shell\"")) fn)
  (write-line (strcat "ret=objWshShell.Popup(strText, " (if (zerop time) "" (cond ( (= (type time) 'int) (itoa time) ) ( (= (type time) 'real) (rtos time) ))) ", strTitle, intType)") fn)
  (write-line "WScript.Echo ret" fn)
  (close fn)
  (setq filename2 (vl-filename-mktemp "XXXX.bat" (getvar 'tmpprefix)))
  (setq fn (open filename2 "w"))
  (write-line (strcat "for /f \"tokens=*\" %%i in ('cscript //nologo " filename1 "') do set RETURN=%%i") fn)
  (write-line (strcat "echo %RETURN% > " (getvar 'tempprefix) "txt.txt") fn)
  (close fn)
  (startapp filename2)
  (while (not (findfile (strcat (getvar 'tempprefix) "txt.txt"))))
  (setq fn (open (strcat (getvar 'tempprefix) "txt.txt") "r"))
  (if (= (type (setq li (read-line fn))) 'str)
    (setq catch (vl-catch-all-error-p (setq ret (vl-catch-all-apply (function atoi) (list li)))))
  )
  (close fn)
  (if (findfile filename1)
    (vl-file-delete filename1)
  )
  (if (findfile filename2)
    (vl-file-delete filename2)
  )
  (if (findfile (strcat (getvar 'tempprefix) "txt.txt"))
    (vl-file-delete (strcat (getvar 'tempprefix) "txt.txt"))
  )
  (if (not catch)
    (if (/= ret -1)
      ret
    )
  )
)

 

HTH.

Regards, M.R.

Edited April 4, 2022 by marko_ribar

[BIGAL]

My Bricscad V20 works fine about 1 second

 

(defun MsgBox (title options message time / WshShell)
   (setq WshShell (vlax-create-object "WScript.Shell"))
    (vlax-invoke WshShell 'Run
	 (strcat "mshta.exe vbscript:close(CreateObject(\"WScript.Shell\").Popup(\""
		  message "\"," (itoa time) ",\"" title "\"," (itoa options)"))"
         )
    )
   (vlax-release-object WshShell)
)

(msgbox  "Pts on wall" 0 "Select COGO points" 1)

 

 

[marko_ribar]

Here is the one stolen from "vle-extension.lsp" founded in root of BricsCAD...

I am posting it as it has good info comment - very exhaustive and well explained...

 

;;================================================================================
;;| FUNCTION : vle-alert                                                         |
;;|------------------------------------------------------------------------------|
;;| Author: Lee Mac, Copyright © 2012 - www.lee-mac.com                          |
;;|------------------------------------------------------------------------------|
;;| Original code: http://lee-mac.com/popup.html                                 |
;;|------------------------------------------------------------------------------|
;;| (vle-alert title msg flags)                                                  |
;;|                                                                              |
;;| shows a message box, which can be customised in wide range (based on Windows |
;;| ::MessageBox() function)                                                     |
;;|                                                                              |
;;| Arguments : 'title' title for the message box (the caption string)           |
;;|           : 'msg'   the message to be displayed; will be word-wrapped        |
;;|           : 'flags' combination (addition) of integers specifying behaviour  |
;;|                                                                              |
;;|           : flags for button :                                               |
;;|                MB_OK                          0                              |
;;|                MB_OKCANCEL                    1                              |
;;|                MB_ABORTRETRYIGNORE            2                              |
;;|                MB_YESNOCANCEL                 3                              |
;;|                MB_YESNO                       4                              |
;;|                MB_RETRYCANCEL                 5                              |
;;|                MB_CANCELTRYCONTINUE           6                              |
;;|                MB_HELP                    16384                              |
;;|                                                                              |
;;|           : flags for icons :                                                |
;;|                MB_ICONHAND / MB_ICONSTOP            16                       |
;;|                MB_ICONQUESTION                      32                       |
;;|                MB_ICONEXCLAMATION                   48                       |
;;|                MB_ICONASTERISK /MB_ICONINFORMATION  64                       |
;;|                                                                              |
;;|           : flags for default button (for <return> input) :                  |
;;|                MB_DEFBUTTON1                  0                              |
;;|                MB_DEFBUTTON2                256                              |
;;|                MB_DEFBUTTON3                512                              |
;;|                MB_DEFBUTTON4                768                              |
;;|                                                                              |
;;|           : flags for behaviour :                                            |
;;|                MB_APPLMODAL                   0                              |
;;|                MB_SYSTEMMODAL              4096                              |
;;|                MB_TASKMODAL                8192                              |
;;|                                                                              |
;;|                MB_SETFOREGROUND           65536                              |
;;|                MB_DEFAULT_DESKTOP_ONLY   131072                              |
;;|                                                                              |
;;|                MB_TOPMOST                262144                              |
;;|                MB_RIGHT                  524288                              |
;;|                MB_RTLREADING            1048576                              |
;;|                                                                              |
;;| Return    :  number of button which was used to finish the dialogue          |
;;|              1   OK button                                                   |
;;|              2   Cancel button                                               |
;;|              3   Abort button                                                |
;;|              4   Retry button                                                |
;;|              5   Ignore button                                               |
;;|              6   Yes button                                                  |
;;|              7   No button                                                   |
;;|              10  Try Again button                                            |
;;|              11  Continue button                                             |
;;|                                                                              |
;;| Example   :  (vle-alert "My CAD App" "Dear Customer ...." (+ 4 32 4096))     |
;;|    will show Yes+No button, the question mark icon, as system modal dialogue |
;;================================================================================
(if (not vle-alert)
  (defun vle-alert ( title msg flags / wsh res )
    (vl-catch-all-apply
      (function
        (lambda ()
          (setq wsh (vlax-create-object "wscript.shell"))
          (setq res (vlax-invoke-method wsh 'popup msg 0 title flags))
        )
      )
    )
    (if wsh (vlax-release-object wsh))
    res
  )
)

 

[marko_ribar]

Here is my latest one, but still the same or a little bit different issue - black background of cmd shell window - (startapp) function : it can't be avoided!!!

Also - it is VBScript method that is used in global...

[ EDIT : I think I've managed to avoid black cmd screen by using (dos_shellexe) function - you must have DosLib installed.../ EDIT ]

 

(defun MsgBox ( title buttons message time / filename fn li catch ret ) ;;; VBScript method ;;;

  ;Val buttons (boolean)
  ;0=OKOnly     1=OKCancel   2=AbortRetryIgnore  3=YesNoCancel    4=YesNo   5=RetryCancel 6=CancelRetryContinue
  ;16=Katakana  32=Question  48=Exclamation      64=Information
  ;0             First button is default.
  ;256             Second button is default.
  ;512             Third button is default.
  ;768             Fourth button is default.
  ;0             Application modal; the user must respond to the message box before continuing work in the current application.
  ;4096         System modal; all applications are suspended until the user responds to the message box.
  ;
  ;Val return
  ;1=OK   2=Cancel   3=Abort   4=Retry   5=Ignor   6=Yes   7=No   nil=TIME elapsed
  ;
  ;Time has to be a number (integer or real), if it's greater than 0, the box automaticaly closes after about
  ;time seconds. If it's set to 0 the box won't close until the user closes it by clicking a button.

  (setq filename (vl-filename-mktemp "XXXX.vbs" (getvar 'tempprefix)))
  (setq fn (open filename "w"))
  (write-line "Dim strText, strTitle, intType, fso, f, ret" fn)
  (write-line (strcat "strText = \"" message "\"") fn)
  (write-line (strcat "strTitle = \"" title "\"") fn)
  (write-line (strcat "intType = " (itoa buttons)) fn)
  (write-line (strcat "ret = WScript.CreateObject(\"WScript.Shell\").Popup(strText, " (if (zerop time) "" (cond ( (= (type time) 'int) (itoa time) ) ( (= (type time) 'real) (rtos time) ))) ", strTitle, intType)") fn)
  (write-line "Set fso = WScript.CreateObject(\"Scripting.FileSystemObject\")" fn)
  (write-line (strcat "Set f = fso.CreateTextFile(\"" (getvar 'tempprefix) "txt.txt\", True)") fn)
  (write-line "f.Write ret" fn)
  (write-line "f.Close" fn)
  (write-line "Set strText = Nothing" fn)
  (write-line "Set strTitle = Nothing" fn)
  (write-line "Set intType = Nothing" fn)
  (write-line "Set fso = Nothing" fn)
  (write-line "Set f = Nothing" fn)
  (write-line "Set ret = Nothing" fn)
  (close fn)
  (if (vl-some (function (lambda ( x ) (vl-string-search "doslib" x))) (arx))
    (dos_shellexe "c:\\windows\\system32\\cscript.exe" (strcat "\"" filename "\" //nologo") 0 3)
    (startapp (strcat "c:\\windows\\system32\\cscript.exe \"" filename "\" //nologo"))
  )
  (while (not (findfile (strcat (getvar 'tempprefix) "txt.txt"))))
  (setq fn (open (strcat (getvar 'tempprefix) "txt.txt") "r"))
  (if (= (type (setq li (read-line fn))) 'str)
    (setq catch (vl-catch-all-error-p (setq ret (vl-catch-all-apply (function atoi) (list li)))))
  )
  (close fn)
  (if (findfile filename)
    (vl-file-delete filename)
  )
  (if (findfile (strcat (getvar 'tempprefix) "txt.txt"))
    (vl-file-delete (strcat (getvar 'tempprefix) "txt.txt"))
  )
  (if (not catch)
    (if (/= ret -1)
      ret
    )
  )
)

 

Edited April 6, 2022 by marko_ribar

[marko_ribar]

Managed to implement msgbox like it should - only you have to have installed DosLib...

Bye...