尺寸避让源码，请指正
本帖最后由 x_s_s_1 于 2013-5-18 15:24 编辑写了个尺寸避让的程序，有建议，请指正。如觉得好用的，赏个币，小生确实太穷了
谢谢大家关注，去掉回复限制了，世界末日都挺过来了(DEFUN C:ccbr (/ SS SC EN_DATA_LST DIS1 DIS2)
(if (or (= (getvar "userr1") "") (equal (getvar "userr1") 0))(setvar "userr1" (getreal "\n请输入比例:")))
(defun x_get_dxf (en n /)
(cdr (assoc n (entget en)))
)
;;;x_ssn函数(x_ssn ss)
;;;ss参数：选折集
;;;返回图元名表
(defun x_ssn (ss / n lst)
(repeat (setq N (sslength ss))
(setq LST (cons (ssname SS (setq N (1- N))) LST))
) ;_ 结束repeat
) ;_ 结束defun
;;;修改组码en 图元名 num 组码 ch 修改为
(defun ch_dxf(en num ch / old_num new_num ent)
(if(setq ent (entget en)
new_num (cons num ch)
old_num (assoc num ent)
) ;_ 结束setq
(entmod (subst new_num old_num ent))
(entmod (reverse (cons new_num (reverse ent))))
) ;_ 结束if
) ;_ 结束defun
;;;获取尺寸图元文字中点坐标,文字宽度,文字角度,文字中点距线距离,图元名
;(dim_txt_data(car (entsel)))
(defun dim_txt_data (dim_en / en pt1 pt2 ang pt3 dist)
(setq en (cdr (assoc -2 (tblsearch "block" (x_get_dxf dim_en 2)))))
;获取尺寸块图元名
(while (/= (x_get_dxf (setq en (entnext en)) 0) "MTEXT"))
;获取尺寸内文字图元名
(setq pt1(x_get_dxf dim_en 11);文字中点坐标
pt2(x_get_dxf dim_en 10);定义点
ang(x_get_dxf en 50);角度
pt3(inters pt2
(polar pt2 ang 100)
pt1
(polar pt1 (+ ang (/ pi 2)) 100)
nil
)
dist (distance pt1 pt3)
)
(list pt1 (x_get_dxf en 42) ang dist dim_en)
)
;;;尺寸文字顺尺寸线方向移动
;(setq en_data(cadr en_data_lst))
(defun dim_txt_move_l(dis1 dis2 ang en_data / dis)
(setq dis (- dis2 dis1))
(ch_dxf
(last en_data)
70
(+ 128 (rem (x_get_dxf (last en_data) 70) 128))
)
(ch_dxf
(last en_data)
11
(polar (car en_data) ang dis)
)
)
;;;尺寸文字垂直尺寸线方向移动
(defun dim_txt_move_v(dis ang en /)
(ch_dxf en 70 (+ 128 (rem (x_get_dxf en 70) 128)))
(ch_dxf en 11 (polar (x_get_dxf en 11) ang dis))
)
;;;根据表内第一元素的xy排序
(defun dim_sort (lst /)
(setq lst
(vl-sort
lst
(function (lambda (e1 e2) (< (car (car e1)) (car (car e2))))
)
)
)
(vl-sort lst
(function
(lambda (e1 e2) (< (cadr (car e1)) (cadr (car e2))))
)
)
)
;;;(setq lst'(1 2 3 4 5 6 7 8 9) newlst nil)
;;;->((1 2 3) (3 4 5) (5 6))
;;;(list->3@2 lst)
(defun list->3@2 (lst / newlst x y)
(repeat (length lst)
(if lst
(setq newlst (cons (list (car lst) (cadr lst) (caddr lst)) newlst)
lst (cddr lst)
)
)
)
(setq
nwelst
(mapcar '(lambda(x)
(vl-remove-if (FUNCTION (LAMBDA (y) (= y nil))) x)
)
(reverse newlst)
)
)
)
(defun dist< (lst sc /)
(if(< (distance (car (nth 0 lst)) (car (nth 1 lst)))
(+ (/ (cadr (nth 0 lst)) 2) (/ (cadr (nth 1 lst)) 2) sc)
)
t
(if (< (distance (car (nth 1 lst)) (car (nth 2 lst)))
(+ (/ (cadr (nth 1 lst)) 2) (/ (cadr (nth 2 lst)) 2) sc)
)
t
)
)
)
(setqss (ssget '((0 . "DIMENSION")))
sc (getvar "userr1")
)
(vl-cmdf "_.dimedit" "_h" ss "")
(setq en_data_lst (dim_sort (mapcar 'dim_txt_data (x_ssn ss))))
(cond
((= (length en_data_lst) 2)
(if (< (setq dis1 (distance (car (nth 0 en_data_lst))
(car (nth 1 en_data_lst))
)
)
(setq dis2 (+ (/ (cadr (nth 0 en_data_lst)) 2)
(/ (cadr (nth 1 en_data_lst)) 2)
sc
)
)
)
(progn
(dim_txt_move_l
dis1
dis2
(+ (caddr (car en_data_lst)) pi)
(car en_data_lst)
)
(dim_txt_move_l
dis1
dis2
(caddr (cadr en_data_lst))
(cadr en_data_lst)
)
)
)
)
((> (length en_data_lst) 2)
(cond
((= 1
(length (last (setq en_data_lst (list->3@2 en_data_lst))))
)
(mapcar'(lambda (x)
(if (dist< x sc)
(dim_txt_move_v
(* 2 (cadddr (cadr x)))
(+ (* 1.5 pi) (caddr (cadr x)))
(last (cadr x))
)
)
)
(reverse (cdr (reverse en_data_lst)))
)
)
((= 2 (length (last en_data_lst)))
(mapcar'(lambda (x)
(if (dist< x sc)
(dim_txt_move_v
(* 2 (cadddr (cadr x)))
(+ (* 1.5 pi) (caddr (cadr x)))
(last (cadr x))
)
)
)
(reverse (cdr (reverse en_data_lst)))
)
(setq en_data_lst (car (reverse en_data_lst)))
(if (< (setq dis1 (distance (car (nth 0 en_data_lst))
(car (nth 1 en_data_lst))
)
)
(setq dis2 (+ (/ (cadr (nth 0 en_data_lst)) 2)
(/ (cadr (nth 1 en_data_lst)) 2)
(* 2 sc)
)
)
)
(dim_txt_move_l
dis1
dis2
(caddr (cadr en_data_lst))
(cadr en_data_lst)
)
)
)
)
)
)
(princ)
)
很少用得到的程序 坐沙发支持一下 看看楼主的程序！ 高手的程序，一定要学习！ 看看楼主的程序
提个想法很多时候那尺寸调整是手动比较好
那尺寸文字以那字高为准，像第1列的话往左移就1倍字高，往右移动就2倍自高。其他同。本可以用夹点移动，但是要准确的话每次要输入距离值。（或者那移动距离定个默认值，根据移动的方向自动判断。）移动都是正交的.最好是支持UCS 看看，学习一下 看看楼主的程序！ 支持一下...... 这是一定用的到的，谢谢啦！