[求助]：文字如何与坐标关联？

francfang

求助高手，能否让文字的内容是文字插入点的X坐标，并且当文字的位置移动时，文字的内容自动更新！！

ljttjl

用对象反应器可以实现，联系ljttjl@ tom.com

taner

2. 
   
3.   [FONT=courier new]
   
4. (defun th-mktxt (string insertionpt hight width ang sty mir lar / ent)
   
5.   (if (= ang nil)
   
6.     (setq ang 0)
   
7.   )
   
8.   (if (= width nil)
   
9.     (setq width 1)
   
10.   )
    
11.   (if (= sty nil)
    
12.     (setq sty (getvar "TEXTSTYLE"))
    
13.   )
    
14.   (if (= lar nil)
    
15.     (setq lar (getvar "CLAYER"))
    
16.   )
    
17.   (if (setq ent (entmakex (list '(0 . "TEXT") '(100 . "AcDbEntity") '
    
18.                                 (100 . "AcDbText") (cons 1 string)
    
19.                                 (cons 10 insertionpt) (cons 40 hight)
    
20.                                 (cons 41 width) (cons 50 (d2r ang))
    
21.                                 (cons 7 sty) (cons 8 lar) (cons 71 mir)
    
22.                           )
    
23.                 )
    
24.       )
    
25.     ent
    
26.   )
    
27. )
    
28. (defun d2r (n)                         ; 角度转弧度
    
29.   (/ (* pi n) 180.0)
    
30. )
    
31. (defun r2d (n)                         ; 弧度转角度
    
32.   (/ (* 180.0 n) pi)
    
33. )
    
34. (defun th-entmake-style (name font / en)
    
35.   (if (setq en (tblobjname "style" name))
    
36.     (th-sub-upd en 3 font)
    
37.     (setq en (entmakex (list '(0 . "STYLE") '(100 . "AcDbSymbolTableRecord")
    
38.                              '(100 . "AcDbTextStyleTableRecord")
    
39.                              (cons 2 name) '(70 . 0) '(40 . 0.0) '
    
40.                              (41 . 1.0) '(50 . 0.0) '(71 . 0) '(42 . 1.0)
    
41.                              (cons 3 font) '(4 . "")
    
42.                        )
    
43.              )
    
44.     )
    
45.   )
    
46.   (setvar "textstyle" name)
    
47.   en
    
48. )
    
49. (defun th-sub-upd (ename code newvalue / assoce el)
    
50.   (setq el (entget ename))
    
51.   (if (setq assoce (assoc code (entget ename)))
    
52.     (setq el (subst
    
53.                (cons code newvalue)
    
54.                assoce
    
55.                el
    
56.              )
    
57.     )
    
58.     (setq el (append
    
59.                el
    
60.                (list (cons code newvalue))
    
61.              )
    
62.     )
    
63.   )
    
64.   (entmod el)
    
65.   (entupd ename)
    
66. )
    
67. (defun uangle (bit kwd msg def bpt / inp)
    
68.   (if def
    
69.     (setq msg (strcat "\n" msg "<" (angtos def) ">: ")
    
70.           bit (* (fix (/ bit 2)))
    
71.     )
    
72.     (setq msg (strcat "\n" msg ": "))
    
73.   )
    
74.   (initget bit kwd)
    
75.   (setq inp (if bpt
    
76.               (getangle msg bpt)
    
77.               (getangle msg)
    
78.             )
    
79.   )
    
80.   (if inp
    
81.     inp
    
82.     def
    
83.   )
    
84. )
    
85. (defun udist (bit kwd msg def bpt / inp)
    
86.   (if def
    
87.     (setq msg (strcat "\n" msg "<" (rtos def) ">:")
    
88.           bit (* 2 (fix (/ bit 2)))
    
89.     )
    
90.     (setq msg (strcat "\n" msg ":"))
    
91.   )
    
92.   (initget bit kwd)
    
93.   (setq inp (if bpt
    
94.               (getdist msg bpt)
    
95.               (getdist msg)
    
96.             )
    
97.   )
    
98.   (if inp
    
99.     inp
    
100.     def
     
101.   )
     
102. )
     
103. (defun c:test (/ ang ent grr hi pt x)
     
104.   (setq hi (vlax-ldata-get "mydict" "hi"))
     
105.   (setq hi (udist 1 "" "文本高" hi nil))
     
106.   (vlax-ldata-put "mydict" "hi" hi)
     
107.   (setq ang (vlax-ldata-get "mydict" "ang"))
     
108.   (setq ang (uangle 1 "" "文本角度" ang nil))
     
109.   (vlax-ldata-put "mydict" "ang" ang)
     
110.   (th-entmake-style "mol" "swiss.ttf")
     
111.   (while (and
     
112.            (setq grr (grread 5))
     
113.            (or
     
114.              (= (car grr) 5)
     
115.              (= (car grr) 12)
     
116.            )
     
117.          )
     
118.     (setq pt (cadr grr))
     
119.     (setq x (rtos (car pt)))
     
120.     (vl-catch-all-apply 'entdel (list ent))
     
121.     (setq ent (th-mktxt x pt hi 1 (r2d ang) "mol" 0 nil))
     
122.   )
     
123.   (princ)
     
124. )
     
125. (defun c:test2 (/ ang ent grr hi pt x)
     
126.   (setq hi (vlax-ldata-get "mydict" "hi"))
     
127.   (setq hi (udist 1 "" "文本高" hi nil))
     
128.   (vlax-ldata-put "mydict" "hi" hi)
     
129.   (setq ang (vlax-ldata-get "mydict" "ang"))
     
130.   (setq ang (uangle 1 "" "文本角度" ang nil))
     
131.   (vlax-ldata-put "mydict" "ang" ang)
     
132.   (th-entmake-style "mol" "swiss.ttf")
     
133.   (while (and
     
134.            (setq grr (grread 5))
     
135.            (or
     
136.              (= (car grr) 5)
     
137.              (= (car grr) 12)
     
138.            )
     
139.          )
     
140.     (setq pt (cadr grr))
     
141.     (setq x (vl-princ-to-string pt))
     
142.     (vl-catch-all-apply 'entdel (list ent))
     
143.     (setq ent (th-mktxt x pt hi 1 (r2d ang) "mol" 0 nil))
     
144.   )
     
145.   (princ)
     
146. )
     
147. 
     
148.   [/FONT]
     

<br />   [FONT=courier new]<br /> (defun th-mktxt (string insertionpt hight width ang sty mir lar / ent)<br />   (if (= ang nil)<br />     (setq ang 0)<br />   )<br />   (if (= width nil)<br />     (setq width 1)<br />   )<br />   (if (= sty nil)<br />     (setq sty (getvar "TEXTSTYLE"))<br />   )<br />   (if (= lar nil)<br />     (setq lar (getvar "CLAYER"))<br />   )<br />   (if (setq ent (entmakex (list '(0 . "TEXT") '(100 . "AcDbEntity") '<br />                                 (100 . "AcDbText") (cons 1 string)<br />                                 (cons 10 insertionpt) (cons 40 hight)<br />                                 (cons 41 width) (cons 50 (d2r ang))<br />                                 (cons 7 sty) (cons 8 lar) (cons 71 mir)<br />                           )<br />                 )<br />       )<br />     ent<br />   )<br /> )<br /> (defun d2r (n)                         ; 角度转弧度<br />   (/ (* pi n) 180.0)<br /> )<br /> (defun r2d (n)                         ; 弧度转角度<br />   (/ (* 180.0 n) pi)<br /> )<br /> (defun th-entmake-style (name font / en)<br />   (if (setq en (tblobjname "style" name))<br />     (th-sub-upd en 3 font)<br />     (setq en (entmakex (list '(0 . "STYLE") '(100 . "AcDbSymbolTableRecord")<br />                              '(100 . "AcDbTextStyleTableRecord")<br />                              (cons 2 name) '(70 . 0) '(40 . 0.0) '<br />                              (41 . 1.0) '(50 . 0.0) '(71 . 0) '(42 . 1.0)<br />                              (cons 3 font) '(4 . "")<br />                        )<br />              )<br />     )<br />   )<br />   (setvar "textstyle" name)<br />   en<br /> )<br /> (defun th-sub-upd (ename code newvalue / assoce el)<br />   (setq el (entget ename))<br />   (if (setq assoce (assoc code (entget ename)))<br />     (setq el (subst<br />                (cons code newvalue)<br />                assoce<br />                el<br />              )<br />     )<br />     (setq el (append<br />                el<br />                (list (cons code newvalue))<br />              )<br />     )<br />   )<br />   (entmod el)<br />   (entupd ename)<br /> )<br /> (defun uangle (bit kwd msg def bpt / inp)<br />   (if def<br />     (setq msg (strcat "\n" msg "<" (angtos def) ">: ")<br />           bit (* (fix (/ bit 2)))<br />     )<br />     (setq msg (strcat "\n" msg ": "))<br />   )<br />   (initget bit kwd)<br />   (setq inp (if bpt<br />               (getangle msg bpt)<br />               (getangle msg)<br />             )<br />   )<br />   (if inp<br />     inp<br />     def<br />   )<br /> )<br /> (defun udist (bit kwd msg def bpt / inp)<br />   (if def<br />     (setq msg (strcat "\n" msg "<" (rtos def) ">:")<br />           bit (* 2 (fix (/ bit 2)))<br />     )<br />     (setq msg (strcat "\n" msg ":"))<br />   )<br />   (initget bit kwd)<br />   (setq inp (if bpt<br />               (getdist msg bpt)<br />               (getdist msg)<br />             )<br />   )<br />   (if inp<br />     inp<br />     def<br />   )<br /> )<br /> (defun c:test (/ ang ent grr hi pt x)<br />   (setq hi (vlax-ldata-get "mydict" "hi"))<br />   (setq hi (udist 1 "" "文本高" hi nil))<br />   (vlax-ldata-put "mydict" "hi" hi)<br />   (setq ang (vlax-ldata-get "mydict" "ang"))<br />   (setq ang (uangle 1 "" "文本角度" ang nil))<br />   (vlax-ldata-put "mydict" "ang" ang)<br />   (th-entmake-style "mol" "swiss.ttf")<br />   (while (and<br />            (setq grr (grread 5))<br />            (or<br />              (= (car grr) 5)<br />              (= (car grr) 12)<br />            )<br />          )<br />     (setq pt (cadr grr))<br />     (setq x (rtos (car pt)))<br />     (vl-catch-all-apply 'entdel (list ent))<br />     (setq ent (th-mktxt x pt hi 1 (r2d ang) "mol" 0 nil))<br />   )<br />   (princ)<br /> )<br /> (defun c:test2 (/ ang ent grr hi pt x)<br />   (setq hi (vlax-ldata-get "mydict" "hi"))<br />   (setq hi (udist 1 "" "文本高" hi nil))<br />   (vlax-ldata-put "mydict" "hi" hi)<br />   (setq ang (vlax-ldata-get "mydict" "ang"))<br />   (setq ang (uangle 1 "" "文本角度" ang nil))<br />   (vlax-ldata-put "mydict" "ang" ang)<br />   (th-entmake-style "mol" "swiss.ttf")<br />   (while (and<br />            (setq grr (grread 5))<br />            (or<br />              (= (car grr) 5)<br />              (= (car grr) 12)<br />            )<br />          )<br />     (setq pt (cadr grr))<br />     (setq x (vl-princ-to-string pt))<br />     (vl-catch-all-apply 'entdel (list ent))<br />     (setq ent (th-mktxt x pt hi 1 (r2d ang) "mol" 0 nil))<br />   )<br />   (princ)<br /> )<br /> <br />   [/FONT]<br />

francfang

楼上的用grread动态显示输入时的x坐标，很感谢！我说的文字移动后更新，应该是用反应器实现的！