|
|
- ;;对图元进行扎堆分组（方框分组）作者：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)
- )
|
|
发表于 2024-3-6 12:47:59