求修改一下这个角度匹配的程序
本帖最后由 lshpool 于 2012-4-21 04:42 编辑;;;;;;下面的程序，总共分为2部分，一个是文字内容匹配，后面是角度匹配，角度匹配的有些问题，见下面批注，希望有高手修改一下
;;;;;;文字内容匹配,让后面选中的文字内容，和第一次选择点样板文字内容变成一样的
(defun c:nrpp ()
(command "undo" "begin")
(setq ent1 (entsel "select text origin:"))
(princ "select text to modify:")
(setq ent_ss (ssget '((-4 . "<OR")
(-4 . "<AND")
(0 . "*TEXT")
(-4 . "AND>")
(-4 . "<AND")
(0 . "mtext")
(-4 . "AND>")
(-4 . "OR>")
)
)
)
(setq ent_list1 (entget (car ent1))
n 0
ent_len (sslength ent_ss)
)
(while (< n ent_len)
(setq ent_list2 (entget (ssname ent_ss n)))
(setq ent_list2
(subst (assoc '1 ent_list1)
(assoc '1 ent_list2)
ent_list2
)
)
(entmod ent_list2)
(setq n (1+ n))
)
(command "undo" "end")(princ)
)
;;;文字方向匹配(jdpp)让所选文字的角度和线段的角度平行
;;;程序缺陷：1、对自定义坐标系支持不好，文字的角度颠倒。2、希望能让文字改变角度后，自动靠近直线段并保持一定距离例如
;;;0.5倍字高。3、不知道何故，在2010版本以上的cad中使用时候，有时候会导致系统崩溃；4、选择文字不能多选
(defun c:jdpp (/ smd gmd ent text_ang ent_list)
(setq smd (getvar "snapmode")
gmd (getvar "gridmode")
)
(command "snapmode" "0")
(command "gridmode" "0")
(princ "\n选择源物体:")
(command "ucs" "ob" pause)
(setvar "UCSICON" 0)
(if (setq ent (entsel "选择目标文字:")
)
(progn
(setq text_ang (angle '(0 0 0) (getvar "UCSXDIR")))
(while (> text_ang (/ pi 2)) (setq text_ang (- text_ang pi)))
(setq ent_list (entget (car ent)))
(setq ent_list (subst (cons 50 text_ang)
(assoc '50 ent_list)
ent_list
)
)
(entmod ent_list)
)
)
(setvar "UCSICON" 1)
(command "ucs" "p")
(setvar "snapmode" smd)
(setvar "gridmode" gmd)
(princ)
)
选择文字另方
(setq ent_ss (ssget '(( 0 . "*TEXT"))))
建议堤供样本文件以配合调试
页:
[1]