点监视器中增加动态提示的一种方法

st788796

2. 
   
3. (defun c:tt (/ _updatetext _newtext edata myerr callback olderr tmptext pt)
   
4.   ;;更新文字
   
5.   (defun _updatetext (str / h el)
   
6.     (setq h (getvar "viewsize"))
   
7.     (entmod
   
8.       (subst (cons 40 (/ h 16.0))
   
9.              (assoc 40 edata)
   
10.              (subst (cons 11 (mapcar '- (getvar "viewctr") (list 0. (/ h 2) 0.)))
    
11.                     (assoc 11 edata)
    
12.                     (subst (cons 1 str) (assoc 1 edata) edata)
    
13.              )
    
14.       )
    
15.     )
    
16.   )
    
17.   ;;设置空白文字
    
18.   (defun _newtext ()
    
19.     (entmakex '((0 . "text")
    
20.                 (62 . 1)
    
21.                 (10 0.0 0.0)
    
22.                 (40 . 1.0)
    
23.                 (50 . 0)
    
24.                 (1 . " ")
    
25.                 (72 . 1)
    
26.                 (73 . 1)
    
27.                )
    
28.     )
    
29.   )
    
30.   ;;动态回调
    
31.   (defun callback (dynpt)
    
32.     (_updatetext
    
33.       (strcat "X=" (rtos (car dynpt) 2 0) "; Y=" (rtos (cadr dynpt) 2 0))
    
34.     ) ;_动态提示文字
    
35.   )
    
36.   ;;错误处理
    
37.   (defun myerr (msg)
    
38.     (and (vlax-erased-p tmptext) (entdel tmptext))
    
39.     (xdrx_pointmonitor)
    
40.     (princ)
    
41.   )
    
42.   (setq        olderr        *error*
    
43.         *error*        myerr
    
44.   )
    
45.   (setq        tmptext        (_newtext) ;_动态提示文字
    
46.         edata        (entget tmptext)
    
47.   )
    
48.   (xdrx_pointmonitor "callback")
    
49.   (getpoint)
    
50.   (xdrx_pointmonitor)
    
51.   (entdel tmptext)
    
52.   (setq *error* olderr)
    
53.   (princ)
    
54. )
    
55. 
    

<br /> (defun c:tt (/ _updatetext _newtext edata myerr callback olderr tmptext pt)<br />   ;;更新文字<br />   (defun _updatetext (str / h el)<br />     (setq h (getvar "viewsize"))<br />     (entmod<br />       (subst (cons 40 (/ h 16.0))<br />              (assoc 40 edata)<br />              (subst (cons 11 (mapcar '- (getvar "viewctr") (list 0. (/ h 2) 0.)))<br />                     (assoc 11 edata)<br />                     (subst (cons 1 str) (assoc 1 edata) edata)<br />              )<br />       )<br />     )<br />   )<br />   ;;设置空白文字<br />   (defun _newtext ()<br />     (entmakex '((0 . "text")<br />                 (62 . 1)<br />                 (10 0.0 0.0)<br />                 (40 . 1.0)<br />                 (50 . 0)<br />                 (1 . " ")<br />                 (72 . 1)<br />                 (73 . 1)<br />                )<br />     )<br />   )<br />   ;;动态回调<br />   (defun callback (dynpt)<br />     (_updatetext<br />       (strcat "X=" (rtos (car dynpt) 2 0) "; Y=" (rtos (cadr dynpt) 2 0))<br />     ) ;_动态提示文字<br />   )<br />   ;;错误处理<br />   (defun myerr (msg)<br />     (and (vlax-erased-p tmptext) (entdel tmptext))<br />     (xdrx_pointmonitor)<br />     (princ)<br />   )<br />   (setq        olderr        *error*<br />         *error*        myerr<br />   )<br />   (setq        tmptext        (_newtext) ;_动态提示文字<br />         edata        (entget tmptext)<br />   )<br />   (xdrx_pointmonitor "callback")<br />   (getpoint)<br />   (xdrx_pointmonitor)<br />   (entdel tmptext)<br />   (setq *error* olderr)<br />   (princ)<br /> )<br /> <br />

st788796

文字始终位于屏幕的底中（只考虑了 WCS）

yuren008

做个对论坛有益的人。

Lisphk

st788796 发表于 2021-1-18 10:11
文字始终位于屏幕的底中（只考虑了 WCS）

谢谢ST大师，帮录制个动画