'Alert' box with focus on DWG? acet-uit-status? Multiple lines?

Hello everybody,

Is there a method to create some kinda of 'alertbox' that is floating over the DWG, without claiming the focus from the dwg?

I found the function (acet-ui-status "Message" "Title") But this only allows 3 lines of text. I want to use a bit more....

Any suggestions on this one?

Just some quotes from another forum:

You have just described a modeless dialog' date=' vs. a modal dialog which blocks access to the parent app until it's closed.

[/quote']

 

Further to Bobby's response: Standard DCL cannot display modeless dialogs' date=' only modal dialogs - you will need to use a third-party application such as OpenDCL for a modeless GUI.

[/quote']

 

EDIT:

 

You could use acet-ui-txted :

(defun _acet-ui-txted ( Caption Note L )
 (if (and acet-ui-txted (vl-consp L) (vl-every ''((x) (eq 'STR (type x))) L)) ; (acet-ui-txted [text [caption [note]]])
   (acet-ui-txted (apply 'strcat (cons (car L) (mapcar '(lambda (x) (strcat "\r\n" x)) (cdr L)))) "Caption" "Note")
 ); if
); defun _acet-ui-txted

 

Example:

(_acet-ui-txted "Caption" "Note"
 '("Row1" "Row2" "Row3" "Row4" "Row5")
)

Thanks for the responce Grrr,

I also found the acet-ui-txted function, but the also keeps the 'focus'.

What i understand from your other postst, what im trying to archieve is not possible?

I also found the acet-ui-txted function, but the also keeps the 'focus'.

Ah damn - you're right, sorry. I'm also not enough familiar with the acet-* functions.

What i understand from your other postst, what im trying to archieve is not possible?

It is, but:

...you will need to use a third-party application such as OpenDCL for a modeless GUI.

Which means additional installation of a software...

Unless someone suggests something different.

What i dont understand is why the function of (acet-ui-status) only supports 3 lines of text.. :-(

What i dont understand is why the function of (acet-ui-status) only supports 3 lines of text.. :-(

Looks like acet-ui-txted is limited up to 15 rows aswell:

(acet-ui-txted  
 ( (lambda ( / s i ) (repeat 100 (setq s (strcat (cond (s (strcat s "\r\n"))("")) (itoa (setq i (1+ (cond (i)(0))))))))) )
 "Caption" "Note"
)

maybe / don't know not exactly what you try to accomplish but you could use grdraw. Here's a very cool example by master Lee :-)

http://www.lee-mac.com/grtext.html

Else you would have to create some sort of smart field or block in combination with lisp routine and reactors to scale after each zoom or pan and maybe put your 'note' on a locked layer.. just thinkin 'aloud.

gr. Rlx

Else you would have to create some sort of smart field or block in combination with lisp routine and reactors to scale after each zoom or pan and maybe put your 'note' on a locked layer.. just thinkin 'aloud.

Funny idea :

(defun C:test nil
 (
   (lambda (txt / cad spc o ll ur)
     (and
       (setq spc (vla-get-Block (vla-get-ActiveLayout (vla-get-ActiveDocument (setq cad (vlax-get-acad-object))))))
       (setq o (vla-AddMText spc (vlax-3d-point '(0. 0. 0.)) 1 txt))
       (progn
         (vla-GetBoundingBox o 'll 'ur)
         (vla-ZoomWindow cad ll ur)
         (vla-ZoomScaled cad 0.5 acZoomScaledRelative)
         (while (not (grread)))
         (repeat 2 (vla-ZoomPrevious cad))
         (vl-catch-all-apply 'vla-Delete (list o))
       )
     )
   )
   "Hello\nWorld!"
 )
)

Funny idea :

that would certainly grabs one attention

Why i try to do is make a 'popup' that gives instant feedback on line length and area etc.

i now have to following code wich does EXACTLY what i want.

BUT

the used (acet-ui-status) function can only handle 3 lines of text.... i want to use alot more of that!

(defun c:MINIQUANTUMPANELAAN (/                     itemarea              itemperimeter         itemlinelength
              itemarclength         itemsplinelength      itemregionperimeter   itemcircumference
              itemsplineperimeter   itemplineperimeter    itemplinelength       itemtracelength
              itemarclength         itemellipselength a b c d p1 p2 itemlength tarea tperim tlength
             )
 (vl-load-com)
 (defun *oo_object_modification* (objreactor objectsmodified)
   (setq selected_objects (vla-get-pickfirstselectionset
                            (vla-get-activedocument (vlax-get-acad-object))
                          )
   )
   (setq itemarea 0
         itemperimeter 0
         itemlinelength 0
         itemarclength 0
         itemsplinelength 0
         itemregionperimeter 0
         itemcircumference 0
         itemsplineperimeter 0
         itemplineperimeter 0
         itemplinelength 0
         itemtracelength 0
         itemarclength 0
         itemellipselength 0
   )
   ;AREA
   (vlax-for n selected_objects 
     (if (vlax-property-available-p n 'area)
       (if (eq (vla-get-objectname n) "AcDbRegion")
         (setq itemarea (+ itemarea (vla-get-area n)))
         (if (vlax-curve-isclosed n)
           (setq itemarea (+ itemarea (vla-get-area n)))
         )
       )
     )
     ;;CIRCLE
     (if (vlax-property-available-p n 'circumference)
       (setq itemcircumference (+ itemcircumference (vla-get-circumference n)))
     )
     ;;SPLINE
     (if (eq (vla-get-objectname n) "AcDbSpline")
       (if (vlax-curve-isclosed n)
         (setq itemsplineperimeter (+ itemsplineperimeter
                                      (vlax-curve-getdistatparam n (vlax-curve-getendparam n))
                                   )
         )
         (setq itemsplinelength (+ itemsplinelength
                                   (vlax-curve-getdistatparam n (vlax-curve-getendparam n))
                                )
         )
       )
     )
     ;;REGION
     (if (eq (vla-get-objectname n) "AcDbRegion")
       (setq itemregionperimeter (+ itemregionperimeter (vla-get-perimeter n)))
     )
     ;;PLINE
     (if (or (eq (vla-get-objectname n) "AcDb2dPolyline")
             (eq (vla-get-objectname n) "AcDbPolyline")
         )
       (if (vlax-curve-isclosed n)
         (setq itemplineperimeter (+ itemplineperimeter
                                     (vlax-curve-getdistatparam n (vlax-curve-getendparam n))
                                  )
         )
         (setq itemplinelength (+ itemplinelength
                                  (vlax-curve-getdistatparam n (vlax-curve-getendparam n))
                               )
         )
       )
     )
     ;;LINE
     (if (eq (vla-get-objectname n) "AcDbLine")
       (setq itemlinelength (+ itemlinelength (vla-get-length n)))
     )
     ;;ARC
     (if (eq (vla-get-objectname n) "AcDbArc")
       (setq itemarclength (+ itemarclength (vla-get-arclength n)))
     )
     (if (eq (vla-get-objectname n) "AcDbEllipse")
       (setq itemellipselength (+ itemellipselength
                                  (vlax-curve-getdistatparam n (vlax-curve-getendparam n))
                               )
       )
     )
     ;;TRACE
     (if (eq (vla-get-objectname n) "AcDbTrace")
       (progn (setq plist (vlax-safearray->list
                            (vlax-variant-value (vla-get-coordinates n))
                          )
              )
              (setq a (list (nth 0 plist) (nth 1 plist) (nth 2 plist)))
              (setq b (list (nth 3 plist) (nth 4 plist) (nth 5 plist)))
              (setq c (list (nth 6 plist) (nth 7 plist) (nth 8 plist)))
              (setq d (list (nth 9 plist) (nth 10 plist) (nth 11 plist)))
              (setq p1 (polar a (angle a b) (/ (distance a b) 2.0)))
              (setq p2 (polar c (angle c d) (/ (distance c d) 2.0)))
              (setq itemtracelength (+ itemtracelength (distance p1 p2)))
       )
     )
   )
   ;;_end vlax-for
   (setq itemperimeter (+ itemcircumference
                          itemsplineperimeter
                          itemregionperimeter
                          itemplineperimeter
                       )
   )
   (setq itemlength (+ itemplinelength itemsplinelength itemlinelength itemtracelength itemarclength itemellipselength)
   )
   (setq tarea (rtos itemarea 2 3))
   (setq HBTotal (+ itemperimeter itemlength))
   (setq HBT (rtos HBTotal 2 3))
   (setq tperim (rtos itemperimeter 2 )
   (setq tlength (rtos itemlength 2 )
   (acet-ui-status (strcat "Totaal oppervlak:		" tarea " m2" "\n"
		    "Totaal lengte:			" HBT " m1") "Mini QuantumPanel"
   )
 )
 ;;OBJECT SELECTION
 (if oo_object_modification
   (progn (vlr-remove oo_object_modification)
          (setq oo_object_modification nil)
   )
 )
 (setq oo_object_modification
        (vlr-miscellaneous-reactor
          nil
          '((:vlr-pickfirstmodified . *oo_object_modification*))
        )
 )
 ;;Command ended  
 (if oo_object_modification_action
   (progn (vlr-remove oo_object_modification_action)
          (setq oo_object_modification_action nil)
   )
 )
 (setq oo_object_modification_action
        (vlr-command-reactor nil
                             '((:vlr-commandended . *oo_object_modification*)
;(:vlr-commandcancelled . *oo_object_modification_CANCEL*))
                              )
        )
 )
)


(defun c:MINIQUANTUMPANELUIT ()

 (if oo_object_modification_action
   (progn (vlr-remove oo_object_modification_action)
          (setq oo_object_modification_action nil)
   )
 )
 (if oo_object_modification
   (progn (vlr-remove oo_object_modification)
          (setq oo_object_modification nil)
   )
 )
)

You want a kinda dockable properties window. Think at this moment there's no way around something like OpenDcl

If you do not mind using a 3rd party add-on, DOSLIB allows you to present a message to a user in a modeless window - in the system tray area.

Could you share some coding on how the modeless window works? That is pretty slick. So In theory that could stay up while you run a sequence of commands?

Basically, stating steps 1... do this.... step 2... do this... etc.

maybe / don't know not exactly what you try to accomplish but you could use grdraw. Here's a very cool example by master Lee :-)

 

 

http://www.lee-mac.com/grtext.html

 

 

Else you would have to create some sort of smart field or block in combination with lisp routine and reactors to scale after each zoom or pan and maybe put your 'note' on a locked layer.. just thinkin 'aloud.

 

 

gr. Rlx

I was looking at the GRTEXT DCL mode. I can not seem to figure out how to place colored text within the alert box as the last demo is shown on the page.

Any ideas?

I was looking at the GRTEXT DCL mode. I can not seem to figure out how to place colored text within the alert box as the last demo is shown on the page.

 

Any ideas?

Please refer to the example program provided (GrDialogDemo.lsp), available at the top of the program page.

Sorry about that Lee... Wasn't looking as usual. My Bad.

Could you share some coding on how the modeless window works? That is pretty slick. So In theory that could stay up while you run a sequence of commands?

 

 

Basically, stating steps 1... do this.... step 2... do this... etc.

Yes, you could make repeated calls to this function, with different text each time. One of the arguments of the function, is how long to keep it visible.

Mostly looking for a slide to popup as the user uses xattach multiple dwgs at the same time.

Right now, the alert shows up, but then I hit ok and (lol sometimes) forget what its asking me to attach.

just for fun and not coded for optimal efficiency , just for easy reading

; just some lunchtime fun - rlx 11 dec 2017
; uses reactor / grread / entmake (Mtext) to emulate autoscale messenger box
; minor update on 12 dec : added c key in grread-loop to change background color
; minor update on 13 dec : killed bug , dropped font and added F9 functionality to grread loop
;                        : couldn't resist , added transparency

(defun c:rlxmessenger  (/ loop gr_input    ent messenger-entity messenger-insertion-point transparency-list messenger-title
           messenger-text-height messenger-body-text messenger-background-color messenger-alignment-code messenger-transparency)
 (init_messenger)
 (setq loop t)
 (while loop
   (setq gr_input (vl-catch-all-apply 'grread (list nil 8 0)))
   ; oh dear , user pressed panic button
   (if    (vl-catch-all-error-p gr_input)
     (progn (princ "\nFunction cancelled") (setq loop nil) (bye-bye)))
   (cond ((user_pressed_lmouse_button)
      (if (setq ent (nentselp (cadr gr_input)))
        (_show (entget (car ent)))
        (princ "\ryou missed...")))
     ((user_pressed_rmouse_button) (setq loop nil) (bye-bye))
     ((user_pressed_c) (change_messenger_background_color))
     ((user_pressed_e) (command "zoom" "e") (update_messenger))
     ((user_pressed_z) (command "'zoom" "") (update_messenger))
     ((user_pressed_+) (command "zoom" "2x") (update_messenger))
     ((user_pressed_-) (command "zoom" ".5x") (update_messenger))
     ((user_pressed_f9) (toggle_snapmode))
     ((user_pressed_tab) (cycle_transparency_list))
     ((user_pressed_space) (relocate_messenger)))))

(defun init_messenger  ()
 (setq    transparency-list '(33554661 33554636 33554610 33554585 33554559 33554534 33554508)
   messenger-reactor (vlr-command-reactor nil '((:vlr-commandended . endcommand)))
   messenger-insertion-point (getvar "viewctr")
   messenger-text-height (/ (getvar "VIEWSIZE") 100.0)
   messenger-title    "Basic properties "
   messenger-background-color 2
   messenger-alignment-code 5
   messenger-transparency (car transparency-list))
 (defun *error* (m) (redraw) (bye-bye))
 (create_messenger_entity
   messenger-insertion-point
   "Messenger Rlx dec 2017 "
   messenger-text-height
   '("Click on any entity to display its prop's" "During execution use following keys"    "+/-/e/z used for zoom"
     "space to select messenger location" "c to change background color" "Tab for transparency" "Left mouse button to select entity"
     "Right mouse button to exit")
   messenger-background-color
   messenger-alignment-code)
 (redraw)
 (prompt "\nPress any key to begin")
 (grread)
 (if messenger-entity
   (progn (entdel messenger-entity) (setq messenger-entity nil)))
 (princ))

(defun bye-bye    ()
 (if messenger-entity (progn (entdel messenger-entity) (setq messenger-entity nil)))
 (if (and messenger-reactor (vlr-added-p messenger-reactor)) (vlr-remove messenger-reactor))
 (princ "\nbye-bye") (redraw) (princ))

(defun get_screen_corners  (/ vc vs ss dx dy x- x+ y- y+)
 ; dX = height * ratio (/ x-pixels y-pixels)
 (setq    vc (getvar "VIEWCTR") vs (getvar "VIEWSIZE") ss (getvar "SCREENSIZE")
   dx (* vs (/ (car ss) (cadr ss)) 0.5) dy (* vs 0.5))
 ; four corner points display
 (setq    x- (- (car vc) dx) x+ (+ (car vc) dx) y- (- (cadr vc) dy) y+ (+ (cadr vc) dy))
 (list x- x+ y- y+))

; pl = pointlist xmin , xmax , ymin & ymax. Devide screen in 3x3 matrix to find aligment
(defun select_messenger_alignment  (/ pnt pl x y x- x+ y- y+ dx dy va ho alignment)
 (setq pnt (getpoint "\nSelect position for messenger screen :"))
 ; first get corners of autocad screen with (Get_Screen_Corners)
 (setq    x  (car pnt) y (cadr pnt) pl (get_screen_corners)
   x- (car pl) x+ (cadr pl) y- (caddr pl) y+ (last pl)
   dx (/ (- x+ x-) 3) dy (/ (- y+ y-) 3))
 (cond    ((< x (+ x- dx)) (setq ha "Left" x  x-))
   ((< x (+ x- (* dx 2))) (setq ha "Center" x (car (getvar "VIEWCTR"))))
   (t (setq ha "Right" x  x+)))
 (cond    ((< y (+ y- dy)) (setq va "Bottom" y  y-))
   ((< y (+ y- (* dy 2))) (setq va "Middle" y (cadr (getvar "VIEWCTR"))))
   (t (setq va "Top" y  y+)))
 (setq    alignment
    (cond ((equal ha "Left")   (cond ((equal va "Top") 1) ((equal va "Middle") 4) ((equal va "Bottom") 7)))
          ((equal ha "Center") (cond ((equal va "Top") 2) ((equal va "Middle") 5) ((equal va "Bottom") ))
          ((equal ha "Right")  (cond ((equal va "Top") 3) ((equal va "Middle") 6) ((equal va "Bottom") 9)))))
; if you want attachmentpoint as string (e.g. "acAttachmentPointTopLeft" or "acAttachmentPointTopCenter") use this
; (setq atm-point (strcat "acAttachmentPoint" va ha))
; in order to use this i.c.w. vla-put-AttachmentPoint convert it with (eval (read atm-point))
; (list atm-point (list x y))
; 'acAttachmentPointTopLeft etc is a constant (int) , 1-9 , so aligment contains this code
; this is later used in (Create_messenger_entity) when constructing the entity list (elist) , (cons 71 atc) , attachmentpoint code
 (list alignment (list x y 0.0)))



(defun calcumus     (/ pl x y x- y- x+ y+ xc yc)
 ; first get corners of autocad screen with (Get_Screen_Corners)
 (setq    pl (get_screen_corners)
   x- (car pl) x+ (cadr pl) y- (caddr pl) y+ (last pl) xc (car (getvar "viewctr"))    yc (cadr (getvar "viewctr")))
 (cond    ((= messenger-alignment-code 1) (setq x x- y y+)) ; TopLeft
   ((= messenger-alignment-code 2) (setq x xc y y+)) ; TopCenter
   ((= messenger-alignment-code 3) (setq x x+ y y+)) ; TopRight
   ((= messenger-alignment-code 4) (setq x x- y yc)) ; MiddleLeft
   ((= messenger-alignment-code 5) (setq x xc y yc)) ; MiddelCenter
   ((= messenger-alignment-code 6) (setq x x+ y yc)) ; MiddelRight
   ((= messenger-alignment-code 7) (setq x x- y y-)) ; BottomLEft
   ((= messenger-alignment-code  (setq x xc y y-)) ; BottomCenter
   ((= messenger-alignment-code 9) (setq x x+ y y-)) ; BottomRight
   (t (setq x xc y yc messenger-alignment-code 5))
 )
 (setq    messenger-insertion-point (list x y 0.0) messenger-text-height (/ (getvar "VIEWSIZE") 100))
)

(defun endcommand  (calling-reactor endcommandinfo / cmd)
 (setq cmd (nth 0 endcommandinfo))
 (if (member cmd '("PAN" "ZOOM" "RTZOOM")) (calcumus) (update_messenger)) (princ))

; here you add all the props you want to see. The result should be a list of strings the messenger box (mtext)
; will scale to match (of course add 100 lines and this obviously wont work...)
(defun _show  (%e)
 (setq messenger-body-text (list (strcat "Entity type  : " (cdr (assoc 0 %e))) (strcat "Entity layer : " (cdr (assoc 8 %e)))))
 (calcumus) (update_messenger))

; %pnt = point , $tts = title string , #th = text height , %bsl = body string list , #bgc = background colour
; atc = attachement code (alignment)
(defun create_messenger_entity    (%pnt $tts #th %bsl #bgc atc / msg str fnt elist)
 ; you can use a font for messenger box but I'm not sure it looks better
 ; (setq fnt "{\\fArial|b0|i0|c0|p0;" msg (strcat fnt "\\H" (rtos #th) "x;\\L\\C250;" $tts "\\l\\H0.75x;\n"))
 (setq msg (strcat "\\C250;\\L" $tts "\\l\n")) ; black color (250 for text and underline for title
 (foreach str %bsl (setq msg (strcat msg "\n" str)))
 (setq msg (strcat msg "}")) ; the order of the elist seems to matter... change order and you may end up with empty mtext
 (setq    elist (list '(0 . "MTEXT") '(100 . "AcDbEntity") (cons 440 messenger-transparency) '(100 . "AcDbMText")
           (cons 10 %pnt) (cons 1 msg) '(90 . 1)(cons 63 #bgc) (cons 40 (/ (getvar "VIEWSIZE") 30.0))
           (cons 71 atc) '(72 . 5) '(441 . 0)))
 (setq messenger-entity (entmakex elist))
 ; also possible to use vla-put i.c.w. for example "acAttachmentPointTopLeft"
 ; downside of this can be that alignment is changed after mtext is placed, not before
 ; (vla-put-AttachmentPoint (vlax-ename->vla-object messenger-entity) (eval (read atc)))
)

(defun relocate_messenger  (/ aligment-data)
 (if messenger-entity
   (progn (entdel messenger-entity) (setq messenger-entity nil)))
 (setq    aligment-data (select_messenger_alignment) messenger-alignment-code (car aligment-data)
   messenger-insertion-point (last aligment-data))
 (update_messenger))

(defun update_messenger     ()
 (if messenger-entity
   (progn (entdel messenger-entity) (setq messenger-entity nil)))
 (create_messenger_entity
   messenger-insertion-point messenger-title messenger-text-height messenger-body-text    messenger-background-color messenger-alignment-code))

(defun change_messenger_background_color  (/ col)
 (if (setq col (acad_colordlg messenger-background-color))
   (progn (setq messenger-background-color col) (update_messenger))))

(defun toggle_snapmode () (setvar "snapmode" (if (= (getvar "snapmode") 1) 0 1)))

; transparency:
; 10 % = (440 . 33554661) , 20 % = (440 . 33554636) , 30 % = (440 . 33554610) 40 % = (440 . 33554585)
; 50 % = (440 . 33554559) , 60 % = (440 . 33554534) , 70 % = (440 . 33554508) , 80 % = (440 . 33554483) , 90 % = (440 . 33554457)
; difference is 25.5 per 10% so 0 % (solid) would (theoretically) be 33554686 and 100% (invissible) would be 33554432

(defun cycle_transparency_list    ()
 (setq    transparency-list      (append (cdr transparency-list) (list (car transparency-list)))
   messenger-transparency (car transparency-list))
 (update_messenger))

; maybe not efficient to use extra defun's but hey, autodesk uses predefined constants etc all the time so bite me
; just don't go over board and put the entire alphabet here

(defun user_pressed_+ ()(if (equal gr_input '(2 43)) t nil))
(defun user_pressed_- ()(if (equal gr_input '(2 45)) t nil))

(defun user_pressed_c ()(if (member gr_input '((2  99) (2 67))) t nil))
(defun user_pressed_e ()(if (member gr_input '((2 101) (2 69))) t nil))
(defun user_pressed_x ()(if (member gr_input '((2 120) (2 88))) t nil))
(defun user_pressed_z ()(if (member gr_input '((2 122) (2 90))) t nil))

(defun user_pressed_f9    () (if (equal gr_input '(2 2)) t  nil))
(defun user_pressed_tab      () (if (equal gr_input '(2 9)) t nil))
(defun user_pressed_enter () (if (equal gr_input '(2 13)) t nil))
(defun user_pressed_space () (if (equal gr_input '(2 32)) t nil))

(defun user_pressed_lmouse_button  () (if (= (car gr_input) 3) t nil))
(defun user_pressed_rmouse_button  () (if (= (car gr_input) 25) t nil))

;(c:rlxmessenger)

gr. Rlx.

updated 13 dec : killed bug, dumped font , added to grread loop c-key for background color and F9 to be able to turn off snap