对图元进行扎堆分组（方框分组）
;;对图元进行扎堆分组（方框分组）作者：tryhi-大海(defun try-ss-zhadui-fenzu2 (ss dist / 采用intersect a b c ca cc flag l l1 lst n)
(defun 采用intersect (a b / ax1 ax2 ay1 ay2 bx1 bx1采用in采用a bx2 bx2采用in采用a by1 by1采用in采用a by2 by2采用in采用a)
(if
(not
(or
(< (setq ax2(caddr a)) (setq bx1(car b)));
(< (setq ay2(cadddr a)) (setq by1(cadr b)));
(> (setq ax1(car a)) (setq bx2(caddr b)));
(> (setq ay1(cadr a)) (setq by2(cadddr b)));
)
)
(list
(min ax1 bx1)(min ay1 by1)
(max ax2 bx2)(max ay2 by2)
)
)
)
;(setq lst '())
(if ss
(progn
(setq l(zd采用ssbox ss))
(setq l
(vl-sort;
l
'(lambda (a b / ax1 ax2 ay1 bx1 bx2 by1)
(if (equal (setq ax1(car a)) (setq bx1(car b)) 1e-3)
(if (equal (setq ay1(cadr a)) (setq by1(cadr b)) 1e-3)
(if (equal (setq ax2(caddr a)) (setq bx2(caddr b)) 1e-3)
(< (cadddr a) (cadddr b))
(< ax2 bx2)
)
(< ay1 by1)
)
(< ax1 bx1)
)
)
)
)
(setq dist (* dist 0.5))
(setq l(mapcar '(lambda(x)(list (- (car x) dist)(- (cadr x) dist)(+ (caddr x) dist)(+ (cadddr x) dist)))l))
(setq k t r nil)
(while k
(setq a(car l)lst nil)
(while (setq ca(car l))
(setq l(cdr l))
(if (setq c (采用intersect a (setq ca(car l))))
(setq a c)
(if (setq cc(vl-some '(lambda(x / b)(if(setq b(采用intersect a x))(list b x)))lst))
(progn
(if (not(equal (car cc) (cadr cc)))
(setq lst(subst (car cc) (cadr cc)lst))
)
(setq a ca)
)
(setq lst(cons a lst)a ca)
)
)
)
(if(=(length lst)(length r))
(setq k nil)
(setq r lst l lst)
)
)
)
)
(setq l(mapcar '(lambda(x)(list (+ (car x) dist)(+ (cadr x) dist)(- (caddr x) dist)(- (cadddr x) dist)))lst))
(mapcar '(lambda(x)(list(list(car x)(cadr x))(list(caddr x)(cadddr x))))l)
)
页:
[1]