尺寸避让源码，请指正

x_s_s_1 · 发表于 2012-10-16 20:32:08

本帖最后由 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
)
)
)
(setq ss (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)
)

(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 
      ) 
    ) 
  ) 
  (setq  ss (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) 
)

psdcdr · 发表于 2012-10-17 08:54:20

很少用得到的程序

龙瀚 · 发表于 2012-10-16 20:44:14

坐沙发支持一下

smartstar · 发表于 2012-10-16 20:47:01

看看楼主的程序！

vlisp2012 · 发表于 2012-10-16 21:02:22

高手的程序，一定要学习！

lz123456 · 发表于 2012-10-16 21:07:48

看看楼主的程序
提个想法很多时候那尺寸调整是手动比较好
那尺寸文字以那字高为准，像第1列的话往左移就1倍字高，往右移动就2倍自高。其他同。本可以用夹点移动，但是要准确的话每次要输入距离值。（或者那移动距离定个默认值，根据移动的方向自动判断。）移动都是正交的.最好是支持UCS

zhengchuan · 发表于 2012-10-16 21:10:33

看看，学习一下

cuyongping · 发表于 2012-10-16 21:35:04

看看楼主的程序！

CTC · 发表于 2012-10-16 21:36:16

kwok · 发表于 2012-10-16 22:00:08

支持一下......

Atsai · 发表于 2012-10-16 22:10:54

这是一定用的到的，谢谢啦！

账号		自动登录	找回密码
密码			注册

[源码] 尺寸避让源码，请指正

本帖子中包含更多资源

评分

本帖被以下淘专辑推荐:

相关帖子

本帖子中包含更多资源