Author Topic: Create a message box (Read 15715 times)

Chris · « **on:** July 17, 2009, 04:35:01 PM »

2010 no longer comes with vba, I have a message box that I have been using for sometime that I got somewhere from someone. Because vba is no longer with AutoCAD (and I dont want to deal with the hastle of downloading the addon for everyone) I need to rewrite the messagebox so I can use it without any vba code. Possibly a dcl or something. any suggestions are appreciated.

Code: [Select]

(defun dwpMsgBox (Title	  Message     MsgBoxType  Icon
		      /		  iicon	      imsgboxtype oldvar
		      result	  strmessage  strtitle
		     )
      (vl-load-com)
      (setq oldvar (getvar "USERI1"))
      (setvar "USERI1" 0)
      (setq strTitle title
	    strMessage
	     Message
	    iIcon Icon
	    iMsgBoxType
	     MsgBoxType
      ) ;_ end of setq
      (vla-eval	acadobject
		(strcat	"ThisDrawing.SetVariable \"USERI1\", "
			"MsgBox \(\""
			strMessage
			"\","
			(itoa (+ iIcon iMsgBoxType))
			",\""
			strTitle
			"\"\)"
		) ;_ end of strcat
      ) ;_ end of vla-eval
      (setq result (GETVAR "USERI1"))
      (SETVAR "USERI1" oldvar)
      result
    ) ;_ end of defun

gile · « **Reply #1 on:** July 17, 2009, 04:55:14 PM »

Hi,

Does this work ?

EDIT: added (vl-load-com) and corrected `Bbuttons' to `buttons'

Code: [Select]

;;; MsgBox (Patrick_35)
;;;
;;; Val buttons
;;; 0   vlax-vbOKOnly
;;; 1   vlax-vbOKCancel
;;; 2   vlax-vbAbortRetryIgnore
;;; 3   vlax-vbYesNoCancel
;;; 4   vlax-vbYesNo
;;; 5   vlax-vbRetryCancel
;;; 16  vlax-vbKatakana
;;; 32  vlax-vbQuestion
;;; 48  vlax-vbExclamation
;;; 64  vlax-vbInformation
;;;
;;; Val return
;;; 1   OK
;;; 2   Cancel
;;; 3   Abort
;;; 4   Retry
;;; 5   Ignor
;;; 6   Yes
;;; 7   No

(defun MsgBox (title buttons message time / return WshShell)
  (setq WshShell (vlax-create-object "WScript.Shell"))
  (setq	return	(vlax-invoke
		  WshShell
		  'Popup
		  message
		  time
		  title
		  (itoa buttons)
		)
  )
  (vlax-release-object WshShell)
  return
)

CAB · « **Reply #2 on:** July 17, 2009, 05:11:09 PM »

May need to add this:

Code: [Select]

(vl-load-com)
What are valid entries for [time]

GDF · « **Reply #3 on:** July 17, 2009, 05:20:41 PM »

So the original MsgBox routine will not work in 2010? $%*&

GDF · « **Reply #4 on:** July 17, 2009, 05:32:05 PM »

How about this One for 2010?

Code: [Select]

;;--------------------------------------------------------
;; MsgBox(prompt[, buttons][, title][, helpfile, context])
;; Buttons:
;; vbOKOnly    0 Display OK button only.
;; vbOKCancel    1 Display OK and Cancel buttons.
;; vbAbortRetryIgnore    2 Display Abort, Retry, and Ignore buttons.
;; vbYesNoCancel    3 Display Yes, No, and Cancel buttons.
;; vbYesNo    4 Display Yes and No buttons.
;; vbRetryCancel    5 Display Retry and Cancel buttons.
;; vbCritical   16 Display Critical Message icon.
;; vbQuestion   32 Display Warning Query icon.
;; vbExclamation   48 Display Warning Message icon.
;; vbInformation   64 Display Information Message icon.
;; vbDefaultButton1    0 First button is default.
;; vbDefaultButton2  256 Second button is default.
;; vbDefaultButton3  512 Third button is default.
;; vbDefaultButton4  768 Fourth button is default.
;; vbApplicationModal    0 Application modal; the user must respond to the 
;; message box before continuing work in the current application.
;; vbSystemModal 4096 System modal; all applications are suspended until the 
;; user responds to the message box.

;; Revised (01-27-03) thanks to Ed Jobe's contribution about snagging the return value.

(defun MsgBox (Title Buttons Message / useri1 value)
  (vl-load-com)
  (or *acad* (setq *acad* (vlax-get-acad-object)))
  (setq useri1 (getvar "useri1"))
  (acad-push-dbmod)
  (vla-eval
    *acad*
    (strcat
      "ThisDrawing.SetVariable \"USERI1\","
      "MsgBox (\""
      Message
      "\","
      (itoa Buttons)
      ",\""
      Title
      "\")"
    )
  )
  (setq value (getvar "useri1"))
  (setvar "useri1" useri1)
  (acad-pop-dbmod)
  value
)
;; (MsgBox "Title" 4 "Message")

GDF · « **Reply #5 on:** July 17, 2009, 05:41:12 PM »

What about using:
http://www.en.na.mcneel.com/doslib.htm

Code: [Select]

(defun ARCH:QUESTION  (LN1 LN2 LN3 LN4 / txmsg buttons)
  (setq LN0 "Confirmation to Proceed :\n\n")
  (setq txmsg (strcat LN0 LN1 LN2 LN3 LN4))
  (setq buttons (list "Yes" "No"))
  (dos_msgboxex
    txmsg
    ;;" Arch : Program    Question ?"
    (strcat " Arch Program" " : Question ?")
    buttons
    4))
;;;(ARCH:QUESTION "First Line\n" "Second Line\n" "Third Line\n" "Fourth Line\n")

gile · « **Reply #6 on:** July 17, 2009, 05:52:01 PM »

Quote

What are valid entries for [time]

time have 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 while the user closes it by clicking a button.

Another way should be the attached DLL.
Four LISP functions are defined whith .NET:
gc-getfiledlg (gc-getfiledlg title directory filter [multiple])
Returns a list of full pathe(s) it allows a multiple files selection if 'multiple' is specified and not nil)
ex: (getfiles "Select files" "C:\\" "Drawing (*.dwg)|*.dwg|All (*.*)|*.*" T)

gc-getfolderdlg (gc-getfolderdlg message [new])
Returns the full path of the selected (or created) folder
ex: (getfolder "Choose or create a folder" T)

gc-inputbox (gc-inputbox title message [default])
Returns a string (user input)
ex: (inputbox "Qizz" "Question 1 :\nHow old is the Captain ?" "58")

gc-messagebox (gc-messagebox title message [button [icon]])
Returns an integer (see integer codes above), if specified, button and icon requires an integer as above.
ex: (gc-messagebox "Alert" "The file yet exists\nDo you want to replace it ?" 4 48)

The ZIP file countains the DLL and source codes.
Error messages displayed on command line are in French

gile · « **Reply #7 on:** July 19, 2009, 12:27:53 PM »

Here's a (poor) english translated version.

gile · « **Reply #8 on:** July 20, 2009, 01:39:34 PM »

Chris, or someone else, can you say if the routine posted in reply 2 (using WshShell activeX) works on AutoCAD 2010 without the VBA module, please ?

Chris · « **Reply #9 on:** July 20, 2009, 04:48:29 PM »

Quote from: gile on July 20, 2009, 01:39:34 PM

Chris, or someone else, can you say if the routine posted in reply 2 (using WshShell activeX) works on AutoCAD 2010 without the VBA module, please ?

Reply 2 works great, just had to get the formatting correct

GDF · « **Reply #10 on:** July 22, 2009, 02:45:32 PM »

Quote from: Chris on July 20, 2009, 04:48:29 PM

Quote from: gile on July 20, 2009, 01:39:34 PM
Chris, or someone else, can you say if the routine posted in reply 2 (using WshShell activeX) works on AutoCAD 2010 without the VBA module, please ?
Reply 2 works great, just had to get the formatting correct

I get an error with the following (what am I doing wrong?):

(MsgBox "Title" 2 "Message Here" 2)

GDF · « **Reply #11 on:** July 22, 2009, 02:47:47 PM »

Quote from: GDF on July 22, 2009, 02:45:32 PM

Quote from: Chris on July 20, 2009, 04:48:29 PM
Quote from: gile on July 20, 2009, 01:39:34 PM
Chris, or someone else, can you say if the routine posted in reply 2 (using WshShell activeX) works on AutoCAD 2010 without the VBA module, please ?
Reply 2 works great, just had to get the formatting correct

I get an error with the following (what am I doing wrong?):

(MsgBox "Title" 2 "Message Here" 2)

I forgot to modify Bbuttons. works now. Thanks for sharing it.

CAB · « **Reply #12 on:** July 23, 2009, 12:09:47 AM »

My DCL solution. Needs testing.

[Old Code Removed, see later post]

taner · « **Reply #13 on:** July 23, 2009, 01:57:53 AM »

牛人啊！佩服！

CAB · « **Reply #14 on:** July 23, 2009, 08:42:16 AM »

Thanks Tanner, I hope to improve it some.

GDF · « **Reply #15 on:** July 23, 2009, 10:41:12 AM »

Alan

Pretty sweet. Will it work for 2010 version?

CAB · « **Reply #16 on:** July 23, 2009, 11:01:19 AM »

It should because it's just a DCL made on the Fly.

The advantage of this routine is that YOU can create some custom buttons.

CAB · « **Reply #17 on:** July 23, 2009, 11:41:04 AM »

Updated version:
Look for this in the code

Code: [Select]

  ;;  create the dcl with buttons
  ;;  List is (<button name> <return value>)
  ;;  ButCode value may be 0 through 15

Where you may define your buttons & return values.

<edit: Old Code Removed>

CAB · « **Reply #18 on:** July 23, 2009, 03:18:21 PM »

Feature added to version 1.2 User defined buttons
Supply a list for ButCode in place of an interger.
Syntax: (MsgBox "Message Box Title" '(256 (("stop" 1)("go" 2)("quit" 0))) '("This is my message."))
Where 256 is a 'Second button is default' code & the following list is the button pairs in a list
"stop" is the button and 1 is the return value. You could also use nil in place of 256.

Code: [Select]

;;----------------------------------------------------------------------
;; MsgBox Ver 1.2   07.16.09
;; By  CAB @ TheSwamp.org
;; Description:  - Message Box with button options
;; Arguments: 3
;;   Title$ = Dialog Title
;;   MsgList = List of text strings, one per line
;;   ButCode = Button Code (add values)
;;     0 Display OK button only.
;;     1 Display OK and Cancel buttons.
;;     2 Display Abort, Retry, and Ignore buttons.
;;     3 Display Yes, No, and Cancel buttons.
;;     4 Display Yes and No buttons.
;;     5 Display Retry and Cancel buttons.
;;    16 Display Critical Message icon.  [ note icons not implemented yet ]
;;    32 Display Warning Query icon.
;;    48 Display Warning Message icon.
;;    64 Display Information Message icon.
;;     0 First button is default.
;;   256 Second button is default.
;;   512 Third button is default.
;;   768 Fourth button is default.;;
;; Syntax: (MsgBox "Message Box Title" 4 '("This is my message." "2nd Line of text."))
;; Button  Return Value
;;  OK         1
;;  Cancel     2  Escape/Cancel defaults to this
;;  Abort      3  Escape/Cancel defaults to this
;;  Retry      4
;;  Ignor      5
;;  Yes        6
;;  No         7
;;
;;  Note when Canceling the Box with the X out or the Escape Key, then  Cancel or Abort
;; will be used or the last button defined if they are not present. That is the code that 
;;  will be returned.  For example the (Yes No) when canceled will return the No code 
;;  because it was the last button defined and there were no Cancel or Abort buttons.
;|
This LISP takes the list of text strings and the button code to write a DCL file in the
folder where "ACAD.PAT" is found. The DCL file "MsgBox.dcl" is created and then called
to display the message box. The text strings should not exceed the displays height & width.
The button codes from the list above may be added to the icon code (not at this time) and
added to the default button code to get the desired results. The return values are hard 
coded in list pairs but may be changed as desired. 

Feature added to version 1.2  User defined buttons
Supply a list for ButCode in place of an interger.
Syntax: (MsgBox "Message Box Title" '(256 (("stop" 1)("go" 2)("quit" 0))) '("This is my message."))
Where 256 is a 'Second button is default' code & the following list is the button pairs in a list
"stop" is the button and 1 is the return value. You could also use nil in place of 256.
|;
;;------------------------------------------------------------------
  )

<edit: Old Code Removed>

GDF · « **Reply #19 on:** July 23, 2009, 04:13:06 PM »

Works in version 2010

Just updated my routines for 2010. Question: can a pull down menu be added for 2010?
I can't get mine to come up.

GDF · « **Reply #20 on:** July 23, 2009, 04:37:24 PM »

Thanks Crank

Crank · « **Reply #21 on:** July 23, 2009, 04:37:43 PM »

Quote from: GDF on July 23, 2009, 04:13:06 PM

...can a pull down menu be added for 2010?

Yes, there are several options possible: rightclick menu; menubar; ribbon or QAT. Please make another topic for this in 'CAD General'.

Now back on topic...

VVA · « **Reply #22 on:** July 24, 2009, 02:33:31 AM »

My attempt to add the icons.
Icons and some functions taken from GetIcon.lsp, created by Terry Miller ( http://web2.airmail.net/terrycad )
Use Test1, Test2, Test3 and Test4 command

CAB · « **Reply #23 on:** July 24, 2009, 01:30:34 PM »

Thanks Vladimir,

I reformatted the vector list removing the extra code and rewrote the Vector_Line function.
New version attached.

GDF · « **Reply #24 on:** July 24, 2009, 02:34:16 PM »

Works in version 2010:

Code: [Select]

(defun MsgBox2 (title buttons message time / return WshShell)
;;http://www.theswamp.org/index.php?topic=29537.0
  (setq WshShell (vlax-create-object "WScript.Shell"))
  (setq	return	(vlax-invoke
		  WshShell
		  'Popup
		  message
		  time
		  title
		  (itoa buttons)
		)
  )
  (vlax-release-object WshShell)
  return
)

(defun MISC-KEY  ()
  (MsgBox " Arch Program : Info" 48 "
      PROGRAM Routines :
--------------------------------------------------------------------------------------------
      CALC\t\tWindows Calculator...
      CLIPBOARD\tWindows Clipboard Viewer...
      CONTROL\tWindows Control Panel...
      EXCEL\tWindows Excel...
      EXPL\t\tWindows Explorer...
      NOTEPAD\tWindows NotePad...
      POWERPOINT\tWindows Power Point..
      PRINTERS\tWindows Printers...
      WINWORD\tWindows WinWord...
      WORDPAD\tWindows WordPad...
    
      ALBUM\tACAD Album...
      AUTODC\tAutoLisp Code Breaker  
      CALU\t\tFoot-Inch Trig Calculator...
      CONVERTOR\tUnit Convertor...
      EDITPAD\tEditPad Editor...      
      FVIEWER\tFont Viewer...
      LLL\t\tMake List to File...
      LISPDOC\tAutoLisp Editor...
      LSPSURF\tAutoLisp Editor...  
      PFE32\tAutoLisp Editor...      
      RESHACKER\tProgram Code Breaker...
      SCRIPTPRO\tScript Pro...
      SLIDEMAN\tSlide Manager...
      VLIDEIT\tVisual Lisp...      
      " 4))

gile · « **Reply #25 on:** July 24, 2009, 03:27:16 PM »

Nice coding Alan

CAB · « **Reply #26 on:** July 24, 2009, 04:40:32 PM »

Thanks Gile, Quite a complement considering the source.

ymg · « **Reply #27 on:** July 03, 2014, 04:49:10 PM »

I know it is a very old thread, but with Patrice's routine I cannot get the
timer option to work.

I have this as a workaround, now the timer works, but I cannot have
the return value if you pressed one of the buttons.

Code: [Select]

;;;***************************************************************************;
;;; MsgBox by Patrick_35                                                      ;
;;;                                                                           ;
;;; Val options                                                               ;
;;; 0   vlax-vbOKOnly                                                         ;
;;; 1   vlax-vbOKCancel                                                       ;
;;; 2   vlax-vbAbortRetryIgnore                                               ;
;;; 3   vlax-vbYesNoCancel                                                    ;
;;; 4   vlax-vbYesNo                                                          ;
;;; 5   vlax-vbRetryCancel                                                    ;
;;; 16  vlax-vbKatakana                                                       ;
;;; 32  vlax-vbQuestion                                                       ;
;;; 48  vlax-vbExclamation                                                    ;
;;; 64  vlax-vbInformation                                                    ;
;;;                                                                           ;
;;; Modified so the timer works by ymg                                        ;
;;; However always returns 0, so cannot detect which button was pressed.      ;
;;;***************************************************************************;
 
(defun MsgBox (title options message time / rtn 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)
)

CAB · « **Reply #28 on:** July 03, 2014, 06:07:37 PM »

This works for me but the timer is off by a factor of 3.
value of 5 takes 15 seconds MOL.

Code: [Select]

(defun MsgBox (title buttons message time / return WshShell)
  (setq WshShell (vlax-create-object "WScript.Shell"))
  (setq    return    (vlax-invoke
          WshShell
          'Popup
          message
          time
          title
          (itoa buttons)
        )
  )
  (vlax-release-object WshShell)
  return
)

ymg · « **Reply #29 on:** July 03, 2014, 07:56:18 PM »

CAB,

Quote

This works for me but the timer is off by a factor of 3.

For me it simply hangs there with the hourglass cursor until I press OK.

Probably depends on version.

ymg

News:

Author Topic: Create a message box (Read 15715 times)

taner

ymg

ymg