https://i.imgur.com/mLu9FYo.png 你能分享一些关于无模式窗口工作原理的代码吗？这很巧妙。所以从理论上讲，当你运行一系列命令时，它可以保持不变？
基本上，说明步骤1。。。这样做。。。。第2步。。。这样做。。。等
我在看GRTEXT DCL模式。我似乎不知道如何在警报框中放置彩色文本，因为页面上显示了最后一个演示。
有什么想法吗？
请参阅程序页面顶部提供的示例程序（GrDialogDemo.lsp）。 对不起，李。。。看起来不像往常。我的错。
是的，您可以重复调用此函数，每次使用不同的文本。函数的一个参数是保持可见的时间。 主要是在用户同时使用xattach多个DWG时，寻找弹出的幻灯片。
现在，警报出现了，但我点击ok（哈哈，有时）忘记了它要求我附加什么。 只是为了好玩，而不是为了最佳效率而编码，只是为了便于阅读
https://www.cadtutor.net/forum/attachment.php?attachmentid=62798&cid=1&stc=1
; 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" xx-))
((< x (+ x- (* dx 2))) (setq ha "Center" x (car (getvar "VIEWCTR"))))
(t (setq ha "Right" xx+)))
(cond ((< y (+ y- dy)) (setq va "Bottom" yy-))
((< y (+ y- (* dy 2))) (setq va "Middle" y (cadr (getvar "VIEWCTR"))))
(t (setq va "Top" yy+)))
(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 '((299) (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)) tnil))
(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)
Rlx级。
12月13日更新：消除了错误，丢弃了字体，添加到grread循环c键中，用于背景色和F9，以便能够关闭快照
页:
1
[2]