用法
评论
建议
取 消
确 定
(defun pickset:cluster (ss gap / a b c ca cc flag l l1 lst n) "对图元进行聚类分析，按片区求图元集的包围盒。" "各图元群的包围盒(两点坐标), 组成的列表" (if ss (progn (setq l (vl-sort (pickset:boxs ss) (quote (lambda (box1 box2 / ax1 ax2 ay1 bx1 bx2 by1) (if (equal (setq ax1 (caar box1)) (setq bx1 (caar box2)) 0.001) (if (equal (setq ay1 (cadar box1)) (setq by1 (cadar box2)) 0.001) (if (equal (setq ax2 (caadr box1)) (setq bx2 (caadr box2)) 0.001) (< (cadadr box1) (cadadr box2)) (< ax2 bx2)) (< ay1 by1)) (< ax1 bx1)))))) (setq gap (* gap 0.5)) (setq l (mapcar (quote (lambda (x) (list (list (- (caar x) gap) (- (cadar x) gap)) (list (+ (caadr x) gap) (+ (cadadr x) gap))))) l)) (setq k t r nil) (while k (setq a (car l) lst nil) (while (setq ca (car l)) (setq l (cdr l)) (if (geometry:box-intersectp a (setq ca (car l))) (progn (setq c (geometry:merge-box a ca)) (setq a c)) (if (setq cc (vl-some (quote (lambda (x) (if (geometry:box-intersectp a x) (list (geometry:merge-box a x) 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 (quote (lambda (x) (list (list (- (caar x) gap) (- (cadar x) gap)) (list (+ (caadr x) gap) (+ (cadadr x) gap))))) lst)))
函数库使用说明
应用包
技术支持
统计信息
函数库规模: 733 个
函数库类别: 51 种
上传记录
刷新
冀公网安备 13050302000400号