社区 › AutoLISP/Visual LISP 编程技术 › ★★★【尺寸文字自动避让程序源码】★★★

lyy 发表于 2009-1-13 18:19:00

★★★【尺寸文字自动避让程序源码】★★★

本帖最后由 作者 于 2009-1-14 10:08:28 编辑 <br /><br /> <p>;;尺寸文字避让<br/>(defun c:yad_dimadjust(/ yad-dxf yad-perpt yad-chgent ss n m ent en ang w h l_dat l_mov oldang mov s pt pt1 pt2 l_adj en l_en disang disw dish item item1)<br/>&nbsp; (defun yad-dxf(en n)<br/>&nbsp;&nbsp;&nbsp; (if (not (listp en)) (setq en (entget en)))<br/>&nbsp;&nbsp;&nbsp; (cdr (assoc n en))<br/>&nbsp; )<br/>&nbsp; (defun yad-perpt(pt pt1 pt2)<br/>&nbsp;&nbsp;&nbsp; (inters pt1 pt2 pt (polar pt (+ (angle pt1 pt2) (/ pi 2)) 1200) nil)<br/>&nbsp; )<br/>&nbsp; (defun yad-chgent(en n / m val)<br/>&nbsp;&nbsp;&nbsp; (if (not (listp en)) (setq en (entget en)))<br/>&nbsp;&nbsp;&nbsp; (foreach itm n<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq m (car itm) val (cadr itm))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (if (assoc m en)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq en (subst (cons m val) (assoc m en) en))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq en (append en (list (cons m val))))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp; (entmod en)<br/>&nbsp; )<br/>&nbsp; (prompt "\n选择需要自动调整文字位置的一组标注尺寸：")<br/>&nbsp; (if (setq ss (ssget '((0 . "dimension")(-4 . "&lt;or")(70 . 0)(70 . 1)(70 . 32)(70 . 33)(70 . 128)(70 . 129)(70 . 160)(70 . 161)(-4 . "or&gt;"))))<br/>&nbsp;&nbsp;&nbsp; (progn<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (vl-cmdf "_undo" "_be")<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (vl-cmdf "_.dimedit" "_h" ss "")<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq n -1 m 0)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (repeat (sslength ss)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq ent (ssname ss (setq n (1+ n))))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq en (yad-dxf (tblsearch "block" (yad-dxf ent 2)) -2))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (while (/= (yad-dxf (setq en (entnext en)) 0) "MTEXT"))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq ang (yad-dxf en 50) h (yad-dxf en 43) w (+ (/ (yad-dxf en 42) 2) (* 0.2 h)) h (* 0.6 h))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq l_dat (cons (list ent ang w h) l_dat))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (if (&lt; (/ (yad-dxf ent 42) 2) w)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (if (= (rem (setq m (1+ m)) 2) 0)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq l_mov (cons (list ent ang w h) l_mov))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq l_mov (append l_mov (list (list ent ang w h))))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (foreach itm l_mov<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq ent (car itm) ang (cadr itm) w (caddr itm) h (cadddr itm) pt (yad-dxf ent 11) oldang (angle pt (yad-perpt pt (setq pt1 (yad-dxf ent 10)) (polar pt1 ang 1200))) mov T)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (while (and mov (setq s (ssget "_f" (list (setq pt1 (polar (polar pt ang w) (+ ang (/ pi 2)) h)) (setq pt2 (polar pt1 (+ ang pi) (* 2 w))) (setq pt2 (polar pt2 (- ang (/ pi 2)) (* 2 h))) (polar pt2 ang (* 2 w)) pt1)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '((0 . "dimension")(-4 . "&lt;or")(70 . 0)(70 . 1)(70 . 32)(70 . 33)(70 . 128)(70 . 129)(70 . 160)(70 . 161)(-4 . "or&gt;"))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq n -1 l_adj nil)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (repeat (sslength s)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq en (ssname s (setq n (1+ n))))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (if (and (ssmemb en ss) (not (equal en ent)) (setq l_en (yad-dxf l_dat en)) (equal ang (car l_en) 0.01))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (progn<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq pt1 (yad-perpt (yad-dxf en 11) pt (polar pt ang 1200))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; disang (angle pt1 pt)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; disw (- (+ w (cadr l_en)) (distance pt pt1))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; dish (- (+ h (caddr l_en)) (distance pt (yad-perpt (yad-dxf en 11) pt (polar pt (+ ang (/ pi 2)) 1200))))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (if (and (&gt; dish 0) (not (equal dish 0 1)))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (if (setq item (vl-member-if '(lambda(e) (equal (car e) disang 0.01)) l_adj))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq item (car item) l_adj (subst (list disang (max disw (cadr item)) (max dish (caddr item))) item l_adj))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq l_adj (cons (list disang disw dish) l_adj))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (cond<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ((not l_adj) (setq mov nil))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ((and (= (length l_adj) 1) (setq item (car l_adj)) (&gt; (setq disw (cadr item)) 0) (not (equal disw 0 1)) (&gt; (caddr item) 0))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (if (&gt; (yad-dxf ent 70) 128)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (progn<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq pt1 (yad-perpt pt (setq pt2 (yad-dxf ent 10)) (polar pt2 ang 1200)))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (yad-chgent ent (list (list 11 (setq pt (polar pt (setq disang (angle pt pt1)) (* 2 (+ (distance pt pt1) (if (equal disang oldang 0.01) 0 h)))))) (list 70 (+ 128 (rem (yad-dxf ent 70) 128)))))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (progn<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq mov nil)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (yad-chgent ent (list (list 11 (polar pt (car item) disw)) (list 70 (+ 128 (rem (yad-dxf ent 70) 128)))))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ((and (= (length l_adj) 2) (setq item (car l_adj) item1 (cadr l_adj))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (or (and (&gt; (setq disw (cadr item)) 0) (not (equal disw 0 1)) (&gt; (caddr item) 0))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (and (&gt; (setq disw (cadr item1)) 0) (not (equal disw 0 1)) (&gt; (caddr item1) 0))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (if (or (&gt; (yad-dxf ent 70) 128) (and (&gt; (caddr item) 0) (&gt; (caddr item1) 0) (&gt; (setq disw (+ (cadr item) (cadr item1))) 0) (not (equal disw 0 1))))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (progn<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq pt1 (yad-perpt pt (setq pt2 (yad-dxf ent 10)) (polar pt2 ang 1200)))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (if (equal pt pt1 1) (setq disang (- ang (/ pi 2))) (setq disang (angle pt pt1)))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (yad-chgent ent (list (list 11 (setq pt (polar pt disang (* 2 (+ (distance pt pt1) (if (equal disang oldang 0.01) 0 h)))))) (list 70 (+ 128 (rem (yad-dxf ent 70) 128)))))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (progn<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq mov nil)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (if (or (&lt; (caddr item) 0) (and (&lt; (setq disw (cadr item)) 0) (not (equal disw 0 1))))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq item item1)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (yad-chgent ent (list (list 11 (polar pt (car item) (cadr item))) (list 70 (+ 128 (rem (yad-dxf ent 70) 128)))))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (T (setq mov nil))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (prompt "\n自动调整完毕！")<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (vl-cmdf "_undo" "_e")<br/>&nbsp;&nbsp;&nbsp; )<br/>&nbsp; )<br/>&nbsp; (princ)<br/>)</p>

magicheno 发表于 2021-8-18 19:36:52

这个程序真好，谢谢楼主

403181713 发表于 2021-8-18 14:00:35

这个程序真好，谢谢楼主

yoyoho 发表于 2019-7-21 12:38:01

谢谢楼主提供的好程序！

carrot1983 发表于 2009-1-13 18:31:00

本帖最后由 作者 于 2009-1-13 18:31:47 编辑 <br /><br /> <p>沙发？？？</p><p>先向楼主的无私奉献致敬。。。</p><p>学习一下。</p><p></p>

caoyin 发表于 2009-1-14 08:39:00

本帖最后由 作者 于 2009-1-14 8:42:34 编辑 <br /><br /> <p>这样的程序楼主也想得出，一级棒！！收藏了。</p>

lyy 发表于 2009-1-14 10:10:00

修正了一下程序！

jxlsp 发表于 2009-1-14 12:41:00

学习一下LYY大哥的。

Gu_xl 发表于 2010-10-12 16:40:00

真的很不错！学习了！

tianquan3 发表于 2010-11-2 17:43:00

好长好长阿。

LIFEI18 发表于 2010-11-6 08:22:00

楼主高手啊

edoumxx 发表于 2011-1-15 12:54:54

看了楼主的介绍，应该是个不错的插件，下了试试一下

yaya-54 发表于 2011-2-25 20:49:18

谢谢。很需要这个程序。

查看完整版本: ★★★【尺寸文字自动避让程序源码】★★★