下划线加反应器自动更新（功能实现但是有点bug）
下划线的代码是@zj20190405在http://bbs.mjtd.com/forum.php?mod=viewthread&tid=172505&highlight=%CF%C2%BB%AE%CF%DF
帖子里发布的，不知道是不是他的原创，取用了就感谢一下！
这两天刚学到反应器，就想着能不能加一个，然后就有了下面这个代码
刚学autolisp不久，写的乱七八糟的，好歹功能是实现了，但是有以下问题
1：源代码是可以批量下划线的，我的反应器没有写循环，所有只能实现最后一下文字划线自动更新
2：没有写单行文字的，只写了多行文字的，自定义变量太多了，脑子昏，以后有机会完善吧
3：！一个神奇的bug：有时候会自动更新，有时候最后还需要编辑一次文本，或者移动它才会更新图元，我明明加了(entmod）啊！
;下划线程序
(vl-load-com)
(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)
(setq ss1 (ssget '((0 . "*TEXT"))))
(setq text (entlast))
(if (null ss1)
(progn
(princ "\n没有文本实体被选择!")
(exit)
) ; end progn
) ; end if
(setq n (sslength ss1))
(if (not (= nil n)) ; no select objects
(progn
(setq i 0)
(while (< i n)
(setq txtentname (ssname ss1 i))
(setq txtentdata (entget txtentname))
(setq i (+ i 1))
(setq txtenttype (cdr (assoc 0 txtentdata)))
; get entity's name:
; "text" or "mtext"
(if (= txtenttype "TEXT") ; this object is simple line text
(progn
(vl-cmdf "ucs" "Object" txtentname)
; 定义用户坐标系到文本的方?
(setq tbox (textbox (list (car txtentdata)))
; must change to a list
pt_bl (car tbox) ; left bottom point coords
pttr (cadr tbox) ; right top point coords
pttl (list (car pt_bl) (cadr pttr))
pt_br (list (car pttr) (cadr pt_bl))
) ; end setq
(setq roundspace (* 0.2 (distance pt_bl pttl)))
(setq pt_bl (polar pt_bl pi (* roundspace 2)))
(setq pt_bl (polar pt_bl (* pi 1.5) roundspace))
(setq pt_br (polar pt_br 0.0 (* roundspace 2)))
(setq pt_br (polar pt_br (* pi 1.5) roundspace)) ;
(vl-cmdf "pline"
pt_bl
"w"
(* roundspace 0.25)
""
pt_br
""
)
(vl-cmdf "CHPROP" (entlast) "" "C" "BYBlock" "")
(vl-cmdf "pline"
(polar pt_bl (* pi 1.5) (* roundspace 0.6))
"w"
0
""
(polar pt_br (* pi 1.5) (* roundspace 0.6))
""
)
(vl-cmdf "CHPROP" (entlast) "" "C" "BYBlock" "")
(vl-cmdf "ucs" "p")
) ; end progn
(progn
(vl-cmdf "_.JustifyText" txtentname "" "TL")
; 处理为对对齐模式.
(setq txtentdata (entget txtentname))
(setq pttl (cdr (assoc 10 txtentdata));文字第一对其点y坐标
xwidth(cdr (assoc 42 txtentdata));文字水平宽度
xheight (cdr (assoc 43 txtentdata));文字水平高度
xangle(cdr (assoc 50 txtentdata));文字旋转角度
pt_tc (polar pttl xangle (* xwidth 0.5))
pttr (polar pttl xangle xwidth)
pt_bl (polar pttl (- xangle (/ pi 2.0)) xheight)
pt_bc (polar pt_bl xangle (* xwidth 0.5))
pt_br (polar pt_bl xangle xwidth)
pt_mc (polar pt_bl (angle pt_bl pttr) (/ (distance pt_bl pttr ) 2.0 )) ; end polar
)
; end setq
(setq roundspace (* 0.2 (distance pt_bl pttl)));字的基准点到第一条直线的垂直距离
(setq xangle (cdr (assoc 50 txtentdata)))
(setq pt_bl (polar pt_bl xangle (- roundspace)))
(setq
pt_bl (polar pt_bl (+ xangle (/ pi 2.0)) (- roundspace))
);第一条直线的左端点
(setq pt_br (polar pt_br xangle roundspace))
(setq pt_br (polar pt_br (+ xangle (/ pi 2.0)) (- roundspace)));第一条直线的右端点
(setq pttl (polar pttl xangle (- roundspace)))
(setq pttl (polar pttl (+ xangle (/ pi 2.0)) roundspace))
(setq pttr (polar pttr xangle roundspace))
(setq pttr (polar pttr (+ xangle (/ pi 2.0)) roundspace)) ;
(vl-cmdf "pline" pt_bl "w" (* roundspace 0.25) "" pt_br "");画第一条直线
(setq eh1(cdr(assoc 5(entget(entlast)))));第一条直线的句柄
(setq pt_bl1 (polar pt_bl (* pi 1.5) (* roundspace 0.6)))
(setq pt_br1 (polar pt_br (* pi 1.5) (* roundspace 0.6)))
(vl-cmdf "CHPROP" (entlast) "" "C" "BYBlock" "")
(vl-cmdf "pline" pt_bl1"w" 0 "" pt_br1 "");画第二条直线
(setq eh2(cdr(assoc 5(entget(entlast)))));第二条直线的句柄
(vl-cmdf "CHPROP" (entlast) "" "C" "BYBlock" "")
; end command
) ; end progn
) ; end if
) ; end while
) ; end progn
); end if
(vl-cmdf "ucs" "W")
(setq l1-l2(list eh1 eh2));两条直线的句柄表
(setq rlt(list(vlax-ename->vla-object text)));字的图元名转换为VLA对象
(setq vrl(vlr-pers(vlr-object-reactor rlt l1-l2 '((:vlr-modified . c-2l)))));反应器链接到圆上，两条直线的句柄表为关联数据，当发生修改该圆
(princ)
)
;反应器
;
(defun c-2l(notifier-object reactor-object parameter-list /)
(setq text(vlax-vla-object->ename notifier-object);VLA对象转换
ec_l (entget text);新字的图元表
pttl_1 (cdr (assoc 10 ec_l));文字第一对其点y坐标
xwidth_1(cdr (assoc 42 ec_l));文字水平宽度
xheight_1 (cdr (assoc 43 ec_l));文字水平高度
xangle_1(cdr (assoc 50 ec_l));文字旋转角度
pt_tc_1 (polar pttl_1 xangle_1 (* xwidth_1 0.5))
pttr_1 (polar pttl_1 xangle_1 xwidth_1)
pt_bl_1 (polar pttl_1 (- xangle_1 (/ pi 2.0)) xheight_1)
pt_bc_1 (polar pt_bl_1 xangle_1 (* xwidth_1 0.5))
pt_br_1 (polar pt_bl_1 xangle_1 xwidth_1)
pt_mc_1 (polar pt_bl_1 (angle pt_bl_1 pttr_1) (/ (distance pt_bl_1 pttr_1 ) 2.0 )) ; end polar
)
(setq el1(handent(car(vlr-data reactor-object))));第一条直线的图元名
(setq el2(handent(cadr(vlr-data reactor-object))));第二条直线的图元名
(setq roundspace_1 (* 0.2 (distance pt_bl_1 pttl_1)));字的基准点到第一条直线的垂直距离
(setq pt_bl_1 (polar pt_bl_1 xangle_1 (- roundspace_1)))
(setq pt_bl_1 (polar pt_bl_1 (+ xangle_1 (/ pi 2.0)) (- roundspace_1)));更改第一条直线的左端点
(setq pt_br_1 (polar pt_br_1 xangle_1 roundspace_1))
(setq pt_br_1 (polar pt_br_1 (+ xangle_1 (/ pi 2.0)) (- roundspace_1)));第一条直线的右端点
(setq ell_1(entget el1));第一条直线的图元表
(setq ell_1(subst(vl-list* 10 pt_bl_1)(assoc 10 ell_1)ell_1));直线的新端点
(setq ell_1(reverse ell_1))
(setq ell_1(subst(vl-list* 10 pt_br_1)(assoc 10 ell_1)ell_1))
(setq ell_1(reverse ell_1))
(entmod ell_1);更新第一条直线
(setq ell_2(entget el2));第二条直线的图元表
(setq pt_bl1_1 (polar pt_bl_1 (* pi 1.5) (* roundspace_1 0.6)))
(setq pt_br1_1 (polar pt_br_1 (* pi 1.5) (* roundspace_1 0.6)))
(setq ell_2(subst(vl-list* 10 pt_bl1_1)(assoc 10 ell_2)ell_2));直线的新端点替换直线
(setq ell_2(reverse ell_2))
(setq ell_2(subst(vl-list* 10 pt_br1_1)(assoc 10 ell_2)ell_2))
(setq ell_2(reverse ell_2))
(entmod ell_2);更新第二条直线
)
谢谢分享，这个功能好 实用的功能，多谢分享 谢谢楼主分享
这个不错，不过还有个问题，整体移动会有问题 这个也是整体移动有问题，但是是间歇的，第一次移动有问题，第二次就好了，第三次有问题，第四次又好了。。http://bbs.mjtd.com/forum.php?mod=viewthread&tid=109731&highlight=%B7%B4%D3%A6%C6%F7 谢谢楼主分享{:1_1:} 谢谢高人分享 http://bbs.mjtd.com/forum.php?mod=viewthread&tid=90348&highlight=%B7%B4%D3%A6%C6%F7&_dsign=64771105
求助反应器entmod无法更新图元（已解决）
页:
[1]
2