Jump to content

Alert box


paulmcz

Recommended Posts

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 by mhupp
dan20047 is to quick!!!
  • Like 1
Link to comment
Share on other sites

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.

Link to comment
Share on other sites

(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 by Crank
Link to comment
Share on other sites

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))

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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 by Crank
  • Thanks 1
Link to comment
Share on other sites

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

Edited by paulmcz
Link to comment
Share on other sites

  • 5 months later...

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 by Paul Li
grammar
Link to comment
Share on other sites

  • 2 weeks later...

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 by marko_ribar
Link to comment
Share on other sites

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)

 

 

Link to comment
Share on other sites

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
  )
)

 

Link to comment
Share on other sites

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 by marko_ribar
Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...