申请一个程序：框选字符与*line线，若字符与*LINE线接触或压住*LINE线，则将该字符
申请一个程序：框选字符与*line线，若字符与*LINE线接触或压住*LINE线，则将该字符改成红色以示警告<p>为使图面整洁，需将大量字符中一些压住线条的字符找出来稍移下位置。</p><p><br/>特申请一个程序：框选字符与*line线，若字符与*LINE线接触或压住*LINE线，则将该字符改成红色以示警告。</p> 本帖最后由 作者 于 2010-2-6 21:39:24 编辑再试试看：
;压线字变红 明经 ZZXXQQ 2010.2.5,2010.2.6
(defun c:tt ()
(if (and (princ "\n选择文字 :") (setq ss (ssget '((0 . "TEXT"))))) (progn
(setq bb (getdist "\n文字四周间隔 <50> :"))
(setq bb (if bb bb 50))
(setq i 0)
(setq oldh (getvar "TEXTSIZE"))
(setq oldsty (getvar "TEXTSTYLE"))
(repeat (sslength ss)
(setq ent (entget(ssname ss i)) i (1+ i))
(setq pt (cdr(assoc 10 ent)))
(setq ang (cdr(assoc 50 ent)))
(setq txtw (cdr(assoc 41 ent)))
(setvar "TEXTSIZE" (cdr(assoc 40 ent)))
(setvar "TEXTSTYLE" (cdr(assoc 7 ent)))
(setq tmp (cadr(textbox(list(assoc 1 ent)))))
(setq txth (cadr tmp))
(setq txt_w (* (car tmp) txtw))
(setq pt (polar (polar pt (+ ang pi) bb) (+ (/ pi -2) ang) bb))
(setq p1 (polar pt ang (+ txt_w bb bb)))
(setq p2 (polar pt (+ (/ pi 2) ang) (+ txth bb bb)))
(setq p3 (polar p2 ang (+ txt_w bb bb)))
(setq plst (list pt p1 p3 p2))
(if (setq ss1 (ssget "CP" plst '((0 . "LINE")))) (progn
(if (assoc 62 ent)
(setq ent (subst (cons 62 1) (assoc 62 ent) ent))
(setq ent (append ent (list (cons 62 1))))
)
(entmod ent)
))
)
(setvar "TEXTSIZE" oldh)
(setvar "TEXTSYTLE" oldsty)
))
(princ)
)
<p>谢谢，CAD2004测试可达到压线字符变红的目的。</p><p>工程实际中，我们一般认为字符与线的间距小于50时，就是“压线”字符了，</p><p>能再加个间距条件吗？当字符与*line距离小于50时，就算是字符“压线”，字符就变红。</p><p>再次感谢<strong><font face="Verdana" color="#da2549">ZZXXQQ版主</font></strong></p> 二楼已改，再试试。 CAD2004测试达到要求，非常感谢<strong><font face="Verdana" color="#da2549">ZZXXQQ版主。</font></strong> 我下来看看
页:
[1]