下划线加反应器自动更新（功能实现但是有点bug）

1506822004

下划线的代码是@zj20190405在http://bbs.mjtd.com/forum.php?mo ... =%CF%C2%BB%AE%CF%DF
帖子里发布的，不知道是不是他的原创，取用了就感谢一下！

这两天刚学到反应器，就想着能不能加一个，然后就有了下面这个代码


刚学autolisp不久，写的乱七八糟的，好歹功能是实现了，但是有以下问题
1：源代码是可以批量下划线的，我的反应器没有写循环，所有只能实现最后一下文字划线自动更新
2：没有写单行文字的，只写了多行文字的，自定义变量太多了，脑子昏，以后有机会完善吧
3：！一个神奇的bug：有时候会自动更新，有时候最后还需要编辑一次文本，或者移动它才会更新图元，我明明加了(entmod）啊！

1506822004

2. ;下划线程序
   
3. (vl-load-com)
   
4. (defun c:xxx ( / i n pt_bc pt_bl pt_br pt_mc pt_tc pttl pttr roundspace ss1 tbox txtentdata txtentname txtenttype xangle xheight xwidth)
   
5.   (setq ss1 (ssget '((0 . "*TEXT"))))
   
6.   (setq text (entlast))
   
7.   (if (null ss1)
   
8.     (progn
   
9.       (princ "\n没有文本实体被选择!")
   
10.       (exit)
    
11.     )                                        ; end progn
    
12.   )                                        ; end if
    
13.   (setq n (sslength ss1))
    
14.   (if (not (= nil n))                        ; no select objects
    
15.     (progn
    
16.       (setq i 0)
    
17.       (while (< i n)
    
18.         (setq txtentname (ssname ss1 i))
    
19.         (setq txtentdata (entget txtentname))
    
20.         (setq i (+ i 1))
    
21.         (setq txtenttype (cdr (assoc 0 txtentdata)))
    
22.                                         ; get entity's name:
    
23.                                         ; "text" or "mtext"
    
24.         (if (= txtenttype "TEXT")        ; this object is simple line text
    
25.           (progn
    
26.             (vl-cmdf "ucs" "Object" txtentname)
    
27.                                         ; 定义用户坐标系到文本的方?
    
28.             (setq tbox        (textbox (list (car txtentdata)))
    
29.                                         ; must change to a list
    
30.                   pt_bl        (car tbox)        ; left bottom point coords
    
31.                   pttr        (cadr tbox)        ; right top point coords
    
32.                   pttl        (list (car pt_bl) (cadr pttr))
    
33.                   pt_br        (list (car pttr) (cadr pt_bl))
    
34.             )                                ; end setq
    
35.             (setq roundspace (* 0.2 (distance pt_bl pttl)))
    
36.             (setq pt_bl (polar pt_bl pi (* roundspace 2)))
    
37.             (setq pt_bl (polar pt_bl (* pi 1.5) roundspace))
    
38.             (setq pt_br (polar pt_br 0.0 (* roundspace 2)))
    
39.             (setq pt_br (polar pt_br (* pi 1.5) roundspace)) ;
    
40.             (vl-cmdf "pline"
    
41.                      pt_bl
    
42.                      "w"
    
43.                      (* roundspace 0.25)
    
44.                      ""
    
45.                      pt_br
    
46.                      ""
    
47.             )
    
48.             (vl-cmdf "CHPROP" (entlast) "" "C" "BYBlock" "")
    
49.             (vl-cmdf "pline"
    
50.                      (polar pt_bl (* pi 1.5) (* roundspace 0.6))
    
51.                      "w"
    
52.                      0
    
53.                      ""
    
54.                      (polar pt_br (* pi 1.5) (* roundspace 0.6))
    
55.                      ""
    
56.             )
    
57.             (vl-cmdf "CHPROP" (entlast) "" "C" "BYBlock" "")
    
58.             (vl-cmdf "ucs" "p")
    
59.           )                                ; end progn
    
60.           (progn
    
61.             (vl-cmdf "_.JustifyText" txtentname "" "TL")
    
62.                                         ; 处理为对对齐模式.
    
63.             (setq txtentdata (entget txtentname))
    
64.             (setq pttl          (cdr (assoc 10 txtentdata));文字第一对其点y坐标
    
65.                   xwidth  (cdr (assoc 42 txtentdata));文字水平宽度
    
66.                   xheight (cdr (assoc 43 txtentdata));文字水平高度
    
67.                   xangle  (cdr (assoc 50 txtentdata));文字旋转角度
    
68.                   pt_tc          (polar pttl xangle (* xwidth 0.5))
    
69.                   pttr          (polar pttl xangle xwidth)
    
70.                   pt_bl          (polar pttl (- xangle (/ pi 2.0)) xheight)
    
71.                   pt_bc          (polar pt_bl xangle (* xwidth 0.5))
    
72.                   pt_br          (polar pt_bl xangle xwidth)
    
73.                   pt_mc          (polar pt_bl (angle pt_bl pttr) (/ (distance pt_bl pttr ) 2.0 ))                ; end polar
    
74.             )
    
75.       ; end setq
    
76.             (setq roundspace (* 0.2 (distance pt_bl pttl)));字的基准点到第一条直线的垂直距离
    
77.             (setq xangle (cdr (assoc 50 txtentdata)))
    
78.             (setq pt_bl (polar pt_bl xangle (- roundspace)))
    
79.             (setq
    
80.               pt_bl (polar pt_bl (+ xangle (/ pi 2.0)) (- roundspace))
    
81.             );第一条直线的左端点
    
82.             (setq pt_br (polar pt_br xangle roundspace))
    
83.             (setq pt_br (polar pt_br (+ xangle (/ pi 2.0)) (- roundspace)));第一条直线的右端点
    
84.             (setq pttl (polar pttl xangle (- roundspace)))
    
85.             (setq pttl (polar pttl (+ xangle (/ pi 2.0)) roundspace))
    
86.             (setq pttr (polar pttr xangle roundspace))
    
87.             (setq pttr (polar pttr (+ xangle (/ pi 2.0)) roundspace)) ;
    
88.             (vl-cmdf "pline" pt_bl "w" (* roundspace 0.25) "" pt_br "");画第一条直线
    
89.       (setq eh1(cdr(assoc 5(entget(entlast)))));第一条直线的句柄
    
90.       (setq pt_bl1 (polar pt_bl (* pi 1.5) (* roundspace 0.6)))
    
91.       (setq pt_br1 (polar pt_br (* pi 1.5) (* roundspace 0.6)))
    
92.             (vl-cmdf "CHPROP" (entlast) "" "C" "BYBlock" "")
    
93.       (vl-cmdf "pline" pt_bl1  "w" 0 "" pt_br1 "");画第二条直线
    
94.       (setq eh2(cdr(assoc 5(entget(entlast)))));第二条直线的句柄
    
95.             (vl-cmdf "CHPROP" (entlast) "" "C" "BYBlock" "")
    
96.                                         ; end command
    
97.           )                                ; end progn
    
98.         )                                ; end if
    
99.       )                                        ; end while
    
100.     )                                        ; end progn
     
101.   ); end if
     
102.   (vl-cmdf "ucs" "W")
     
103.     (setq l1-l2(list eh1 eh2));两条直线的句柄表
     
104.   (setq rlt(list(vlax-ename->vla-object text)));字的图元名转换为VLA对象
     
105.   (setq vrl(vlr-pers(vlr-object-reactor rlt l1-l2 '((:vlr-modified . c-2l)))));反应器链接到圆上，两条直线的句柄表为关联数据，当发生修改该圆
     
106.   (princ)
     
107. )
     
108. 
     
109. ;反应器
     
110. ;         
     
111. (defun c-2l(notifier-object reactor-object parameter-list /)
     
112.   (setq text(vlax-vla-object->ename notifier-object);VLA对象转换
     
113.     ec_l (entget text);新字的图元表
     
114.       pttl_1          (cdr (assoc 10 ec_l));文字第一对其点y坐标
     
115.                   xwidth_1  (cdr (assoc 42 ec_l));文字水平宽度
     
116.                   xheight_1 (cdr (assoc 43 ec_l));文字水平高度
     
117.                   xangle_1  (cdr (assoc 50 ec_l));文字旋转角度
     
118.                   pt_tc_1          (polar pttl_1 xangle_1 (* xwidth_1 0.5))
     
119.                   pttr_1          (polar pttl_1 xangle_1 xwidth_1)
     
120.                   pt_bl_1          (polar pttl_1 (- xangle_1 (/ pi 2.0)) xheight_1)
     
121.                   pt_bc_1          (polar pt_bl_1 xangle_1 (* xwidth_1 0.5))
     
122.                   pt_br_1          (polar pt_bl_1 xangle_1 xwidth_1)
     
123.                   pt_mc_1          (polar pt_bl_1 (angle pt_bl_1 pttr_1) (/ (distance pt_bl_1 pttr_1 ) 2.0 ))                ; end polar
     
124.             )
     
125.   (setq el1(handent(car(vlr-data reactor-object))));第一条直线的图元名
     
126.   (setq el2(handent(cadr(vlr-data reactor-object))));第二条直线的图元名
     
127. 
     
128.     (setq roundspace_1 (* 0.2 (distance pt_bl_1 pttl_1)));字的基准点到第一条直线的垂直距离
     
129.             
     
130.   
     
131.   (setq pt_bl_1 (polar pt_bl_1 xangle_1 (- roundspace_1)))
     
132.   (setq pt_bl_1 (polar pt_bl_1 (+ xangle_1 (/ pi 2.0)) (- roundspace_1)));更改第一条直线的左端点
     
133.         (setq pt_br_1 (polar pt_br_1 xangle_1 roundspace_1))
     
134.         (setq pt_br_1 (polar pt_br_1 (+ xangle_1 (/ pi 2.0)) (- roundspace_1)));第一条直线的右端点
     
135. (setq ell_1(entget el1));第一条直线的图元表
     
136. (setq ell_1(subst(vl-list* 10 pt_bl_1)(assoc 10 ell_1)ell_1));直线的新端点
     
137. (setq ell_1(reverse ell_1))
     
138. (setq ell_1(subst(vl-list* 10 pt_br_1)(assoc 10 ell_1)ell_1))
     
139. (setq ell_1(reverse ell_1))
     
140.   (entmod ell_1);更新第一条直线
     
141.   (setq ell_2(entget el2));第二条直线的图元表
     
142.     (setq pt_bl1_1 (polar pt_bl_1 (* pi 1.5) (* roundspace_1 0.6)))
     
143.   (setq pt_br1_1 (polar pt_br_1 (* pi 1.5) (* roundspace_1 0.6)))
     
144. (setq ell_2(subst(vl-list* 10 pt_bl1_1)(assoc 10 ell_2)ell_2));直线的新端点替换直线
     
145. (setq ell_2(reverse ell_2))
     
146. (setq ell_2(subst(vl-list* 10 pt_br1_1)(assoc 10 ell_2)ell_2))
     
147. (setq ell_2(reverse ell_2))
     
148. (entmod ell_2);更新第二条直线
     
149. )
     

;下划线程序<br /> (vl-load-com)<br /> (defun c:xxx ( / i n pt_bc pt_bl pt_br pt_mc pt_tc pttl pttr roundspace ss1 tbox txtentdata txtentname txtenttype xangle xheight xwidth)<br />   (setq ss1 (ssget '((0 . "*TEXT"))))<br />   (setq text (entlast))<br />   (if (null ss1)<br />     (progn<br />       (princ "\n没有文本实体被选择!")<br />       (exit)<br />     )                                        ; end progn<br />   )                                        ; end if<br />   (setq n (sslength ss1))<br />   (if (not (= nil n))                        ; no select objects<br />     (progn<br />       (setq i 0)<br />       (while (< i n)<br />         (setq txtentname (ssname ss1 i))<br />         (setq txtentdata (entget txtentname))<br />         (setq i (+ i 1))<br />         (setq txtenttype (cdr (assoc 0 txtentdata)))<br />                                         ; get entity's name:<br />                                         ; "text" or "mtext"<br />         (if (= txtenttype "TEXT")        ; this object is simple line text<br />           (progn<br />             (vl-cmdf "ucs" "Object" txtentname)<br />                                         ; 定义用户坐标系到文本的方?<br />             (setq tbox        (textbox (list (car txtentdata)))<br />                                         ; must change to a list<br />                   pt_bl        (car tbox)        ; left bottom point coords<br />                   pttr        (cadr tbox)        ; right top point coords<br />                   pttl        (list (car pt_bl) (cadr pttr))<br />                   pt_br        (list (car pttr) (cadr pt_bl))<br />             )                                ; end setq<br />             (setq roundspace (* 0.2 (distance pt_bl pttl)))<br />             (setq pt_bl (polar pt_bl pi (* roundspace 2)))<br />             (setq pt_bl (polar pt_bl (* pi 1.5) roundspace))<br />             (setq pt_br (polar pt_br 0.0 (* roundspace 2)))<br />             (setq pt_br (polar pt_br (* pi 1.5) roundspace)) ;<br />             (vl-cmdf "pline"<br />                      pt_bl<br />                      "w"<br />                      (* roundspace 0.25)<br />                      ""<br />                      pt_br<br />                      ""<br />             )<br />             (vl-cmdf "CHPROP" (entlast) "" "C" "BYBlock" "")<br />             (vl-cmdf "pline"<br />                      (polar pt_bl (* pi 1.5) (* roundspace 0.6))<br />                      "w"<br />                      0<br />                      ""<br />                      (polar pt_br (* pi 1.5) (* roundspace 0.6))<br />                      ""<br />             )<br />             (vl-cmdf "CHPROP" (entlast) "" "C" "BYBlock" "")<br />             (vl-cmdf "ucs" "p")<br />           )                                ; end progn<br />           (progn<br />             (vl-cmdf "_.JustifyText" txtentname "" "TL")<br />                                         ; 处理为对对齐模式.<br />             (setq txtentdata (entget txtentname))<br />             (setq pttl          (cdr (assoc 10 txtentdata));文字第一对其点y坐标<br />                   xwidth  (cdr (assoc 42 txtentdata));文字水平宽度<br />                   xheight (cdr (assoc 43 txtentdata));文字水平高度<br />                   xangle  (cdr (assoc 50 txtentdata));文字旋转角度<br />                   pt_tc          (polar pttl xangle (* xwidth 0.5))<br />                   pttr          (polar pttl xangle xwidth)<br />                   pt_bl          (polar pttl (- xangle (/ pi 2.0)) xheight)<br />                   pt_bc          (polar pt_bl xangle (* xwidth 0.5))<br />                   pt_br          (polar pt_bl xangle xwidth)<br />                   pt_mc          (polar pt_bl (angle pt_bl pttr) (/ (distance pt_bl pttr ) 2.0 ))                ; end polar<br />             )<br />       ; end setq<br />             (setq roundspace (* 0.2 (distance pt_bl pttl)));字的基准点到第一条直线的垂直距离<br />             (setq xangle (cdr (assoc 50 txtentdata)))<br />             (setq pt_bl (polar pt_bl xangle (- roundspace)))<br />             (setq<br />               pt_bl (polar pt_bl (+ xangle (/ pi 2.0)) (- roundspace))<br />             );第一条直线的左端点<br />             (setq pt_br (polar pt_br xangle roundspace))<br />             (setq pt_br (polar pt_br (+ xangle (/ pi 2.0)) (- roundspace)));第一条直线的右端点<br />             (setq pttl (polar pttl xangle (- roundspace)))<br />             (setq pttl (polar pttl (+ xangle (/ pi 2.0)) roundspace))<br />             (setq pttr (polar pttr xangle roundspace))<br />             (setq pttr (polar pttr (+ xangle (/ pi 2.0)) roundspace)) ;<br />             (vl-cmdf "pline" pt_bl "w" (* roundspace 0.25) "" pt_br "");画第一条直线<br />       (setq eh1(cdr(assoc 5(entget(entlast)))));第一条直线的句柄<br />       (setq pt_bl1 (polar pt_bl (* pi 1.5) (* roundspace 0.6)))<br />       (setq pt_br1 (polar pt_br (* pi 1.5) (* roundspace 0.6)))<br />             (vl-cmdf "CHPROP" (entlast) "" "C" "BYBlock" "")<br />       (vl-cmdf "pline" pt_bl1  "w" 0 "" pt_br1 "");画第二条直线<br />       (setq eh2(cdr(assoc 5(entget(entlast)))));第二条直线的句柄<br />             (vl-cmdf "CHPROP" (entlast) "" "C" "BYBlock" "")<br />                                         ; end command<br />           )                                ; end progn<br />         )                                ; end if<br />       )                                        ; end while<br />     )                                        ; end progn<br />   ); end if<br />   (vl-cmdf "ucs" "W")<br />     (setq l1-l2(list eh1 eh2));两条直线的句柄表<br />   (setq rlt(list(vlax-ename->vla-object text)));字的图元名转换为VLA对象<br />   (setq vrl(vlr-pers(vlr-object-reactor rlt l1-l2 '((:vlr-modified . c-2l)))));反应器链接到圆上，两条直线的句柄表为关联数据，当发生修改该圆<br />   (princ)<br /> )<br /> <br /> ;反应器<br /> ;          <br /> (defun c-2l(notifier-object reactor-object parameter-list /)<br />   (setq text(vlax-vla-object->ename notifier-object);VLA对象转换<br />     ec_l (entget text);新字的图元表<br />       pttl_1          (cdr (assoc 10 ec_l));文字第一对其点y坐标<br />                   xwidth_1  (cdr (assoc 42 ec_l));文字水平宽度<br />                   xheight_1 (cdr (assoc 43 ec_l));文字水平高度<br />                   xangle_1  (cdr (assoc 50 ec_l));文字旋转角度<br />                   pt_tc_1          (polar pttl_1 xangle_1 (* xwidth_1 0.5))<br />                   pttr_1          (polar pttl_1 xangle_1 xwidth_1)<br />                   pt_bl_1          (polar pttl_1 (- xangle_1 (/ pi 2.0)) xheight_1)<br />                   pt_bc_1          (polar pt_bl_1 xangle_1 (* xwidth_1 0.5))<br />                   pt_br_1          (polar pt_bl_1 xangle_1 xwidth_1)<br />                   pt_mc_1          (polar pt_bl_1 (angle pt_bl_1 pttr_1) (/ (distance pt_bl_1 pttr_1 ) 2.0 ))                ; end polar<br />             )<br />   (setq el1(handent(car(vlr-data reactor-object))));第一条直线的图元名<br />   (setq el2(handent(cadr(vlr-data reactor-object))));第二条直线的图元名<br /> <br />     (setq roundspace_1 (* 0.2 (distance pt_bl_1 pttl_1)));字的基准点到第一条直线的垂直距离<br />             <br />   <br />   (setq pt_bl_1 (polar pt_bl_1 xangle_1 (- roundspace_1)))<br />   (setq pt_bl_1 (polar pt_bl_1 (+ xangle_1 (/ pi 2.0)) (- roundspace_1)));更改第一条直线的左端点<br />         (setq pt_br_1 (polar pt_br_1 xangle_1 roundspace_1))<br />         (setq pt_br_1 (polar pt_br_1 (+ xangle_1 (/ pi 2.0)) (- roundspace_1)));第一条直线的右端点<br /> (setq ell_1(entget el1));第一条直线的图元表<br /> (setq ell_1(subst(vl-list* 10 pt_bl_1)(assoc 10 ell_1)ell_1));直线的新端点<br /> (setq ell_1(reverse ell_1))<br /> (setq ell_1(subst(vl-list* 10 pt_br_1)(assoc 10 ell_1)ell_1))<br /> (setq ell_1(reverse ell_1))<br />   (entmod ell_1);更新第一条直线<br />   (setq ell_2(entget el2));第二条直线的图元表<br />     (setq pt_bl1_1 (polar pt_bl_1 (* pi 1.5) (* roundspace_1 0.6)))<br />   (setq pt_br1_1 (polar pt_br_1 (* pi 1.5) (* roundspace_1 0.6)))<br /> (setq ell_2(subst(vl-list* 10 pt_bl1_1)(assoc 10 ell_2)ell_2));直线的新端点替换直线<br /> (setq ell_2(reverse ell_2))<br /> (setq ell_2(subst(vl-list* 10 pt_br1_1)(assoc 10 ell_2)ell_2))<br /> (setq ell_2(reverse ell_2))<br /> (entmod ell_2);更新第二条直线<br /> )<br />

lxl217114

谢谢分享，这个功能好

sunny_8848

实用的功能，多谢分享

中国梦

谢谢楼主分享

sandyvs

这个不错，不过还有个问题，整体移动会有问题

sandyvs

这个也是整体移动有问题，但是是间歇的，第一次移动有问题，第二次就好了，第三次有问题，第四次又好了。。http://bbs.mjtd.com/forum.php?mo ... =%B7%B4%D3%A6%C6%F7

hzyhzjjzh

谢谢楼主分享

paulpipi

谢谢高人分享

ferious

http://bbs.mjtd.com/forum.php?mo ... amp;_dsign=64771105
求助反应器entmod无法更新图元（已解决）