求助动态坐标反应器的操作

Newbuser

最近用反应器制作了个动态坐标显示的东西，可惜只能照猫画虎做个连接到点实体的对象反应器来实现，无法做个自身随位置改变而改变的反应器。请相关高手伸出援助之手。下面放上我 的lisp代码和操作效果。奇怪的是如果同时移动点和文字，而文字会在原来的位置和新移动到的位置显示两个实体，用regen刷新后原来位置上的就消失了。

2. (vl-load-com)
   
3. (defun c:bb ()
   
4.   (setq e-pt (car (entsel "\n 点")))
   
5.   (setq e-text (car (entsel "\n 文字")))
   
6.   (setq  el-pt  (entget e-pt)
   
7.   str  (strcat  "X="
   
8.       (rtos (cadr (assoc 10 el-pt)) 2 3)
   
9.       " Y="
   
10.       (rtos (caddr (assoc 10 el-pt)) 2 3)
    
11.     )
    
12.   el-text  (entget e-text)
    
13.   jb  (list (cdr (assoc 5 el-text)))
    
14.   obj-pt  (list (vlax-ename->vla-object e-pt))
    
15.   )
    
16.   (setq
    
17.     vrl  (vlr-pers
    
18.     (vlr-object-reactor obj-pt jb '((:vlr-modified . c-2l)))
    
19.   )
    
20.   )
    
21.   (princ)
    
22.     (setq el-text (subst (cons 1 str) (assoc 1 el-text) el-text))
    
23.     (entmod el-text)
    
24.     (setq loop T)
    
25. (while loop
    
26.   (setq  code (grread T 8)
    
27.   mod  (car code)
    
28.   val  (cadr code)
    
29.   )
    
30.   (cond
    
31.     ((= 5 mod)
    
32.      (setq el-pt (subst (cons 10 val) (assoc 10 el-pt) el-pt))
    
33.      (entmod el-pt)
    
34.      (command "regen")
    
35.     )
    
36.     ((or (= 3 mod) (= 25 mod)) (setq loop nil))
    
37.   )
    
38. )
    
39. )
    
40. 
    
41. (defun c-2l (notifier-object
    
42.        reactor-object
    
43.        parameter-list
    
44.        /
    
45.       )
    
46.   (setq  p (vlax-safearray->list
    
47.       (vlax-variant-value
    
48.         (vla-get-Coordinates notifier-object)
    
49.       )
    
50.     )
    
51.   )
    
52.   (setq str (strcat "X=" (rtos (car p) 2 3) "  Y=" (rtos (cadr p) 2 3)))
    
53.   (setq e (handent (car (vlr-data reactor-object)))) ;获取文本图元名
    
54.   (setq el (entget e))
    
55.   (setq el (subst (vl-list* 1 str) (assoc 1 el) el))
    
56.   (entmod el)        ;更新文本图元表
    
57. )
    

(vl-load-com)<br /> (defun c:bb ()<br />   (setq e-pt (car (entsel "\n 点")))<br />   (setq e-text (car (entsel "\n 文字")))<br />   (setq  el-pt  (entget e-pt)<br />   str  (strcat  "X="<br />       (rtos (cadr (assoc 10 el-pt)) 2 3)<br />       " Y="<br />       (rtos (caddr (assoc 10 el-pt)) 2 3)<br />     )<br />   el-text  (entget e-text)<br />   jb  (list (cdr (assoc 5 el-text)))<br />   obj-pt  (list (vlax-ename->vla-object e-pt))<br />   )<br />   (setq<br />     vrl  (vlr-pers<br />     (vlr-object-reactor obj-pt jb '((:vlr-modified . c-2l)))<br />   )<br />   )<br />   (princ)<br />     (setq el-text (subst (cons 1 str) (assoc 1 el-text) el-text))<br />     (entmod el-text)<br />     (setq loop T)<br /> (while loop<br />   (setq  code (grread T 8)<br />   mod  (car code)<br />   val  (cadr code)<br />   )<br />   (cond<br />     ((= 5 mod)<br />      (setq el-pt (subst (cons 10 val) (assoc 10 el-pt) el-pt))<br />      (entmod el-pt)<br />      (command "regen")<br />     )<br />     ((or (= 3 mod) (= 25 mod)) (setq loop nil))<br />   )<br /> )<br /> )<br /> <br /> (defun c-2l (notifier-object<br />        reactor-object<br />        parameter-list<br />        /<br />       )<br />   (setq  p (vlax-safearray->list<br />       (vlax-variant-value<br />         (vla-get-Coordinates notifier-object)<br />       )<br />     )<br />   )<br />   (setq str (strcat "X=" (rtos (car p) 2 3) "  Y=" (rtos (cadr p) 2 3)))<br />   (setq e (handent (car (vlr-data reactor-object)))) ;获取文本图元名<br />   (setq el (entget e))<br />   (setq el (subst (vl-list* 1 str) (assoc 1 el) el))<br />   (entmod el)        ;更新文本图元表<br /> )<br />