请看9楼，也有同样的容差问题。求解决。辛苦了！！
(and (equal (+ (car e) (cadr e)) (car (nth (+ d i 1) waco))0.01)
(= (caddr e) (caddr (nth (+ d i 1) waco)))
) gaics 发表于 2023-8-15 17:18
(and (equal (+ (car e) (cadr e)) (car (nth (+ d i 1) waco))0.01)
(= (caddr e) (caddr (nth ...
谢谢！成了，又多学习一个函数。 本帖最后由 vitalgg 于 2023-8-16 06:57 编辑
(setq waco1
'((0 468.548 1) (468.548 1332.85 1) (3041.5 675.413 4) (5396.91 547.939 3) (5944.85 360.787 3) (7145.64 278.132 3) (7423.77 991.957 3) (8415.73 468.926 4)))
(princ "原表:")(princ waco1)
;; 按色号排序并分组
(setq waco1 (vl-sort
waco1
'(lambda (x y)
(<
(last x)
(last y)))))
(setq waco1 (list:group-by
waco1
'(lambda (x y)
(=
(last x)
(last y)))))
;; 组内起点从小到大排序
(setq waco1 (mapcar
'(lambda (x)
(vl-sort
x
'(lambda (m n)
(< (car m) (car n)))))
waco1))
;; (princ "\n排序表:")(princ waco1)
;; 合并同色且连续的，即前一个的起点+长度 >= 紧临表的起点
(defun join-line (lst / res fuzz)
(setq fuzz 0.01)
(setq res (cons (car lst) nil))
(while (setq lst (cdr lst))
(if
(and
(setq f (car res))
(>= (+ (+ (car f) (cadr f)) fuzz) (caar lst)))
(setq res (cons
(list
(caar res)
(max
(+ (cadar lst) (- (caar lst) (caar res)))
(cadar res))
(last (car res)))
(cdr res)))
(setq res (cons (car lst) res))))
(reverse res)
)
(princ "\n结果:")(princ (apply 'append (mapcar 'join-line waco1)))
(princ)
非得有现成的函数才会用容差吗？
(>= (+ (+ (car f) (cadr f)) fuzz) (caar lst)))
vitalgg 发表于 2023-8-16 06:53
非得有现成的函数才会用容差吗？
(>= (+ (+ (car f) (cadr f)) fuzz) (caar lst)))
谢谢！高手的代码改起来一下子糊涂了:lol overkill命令用一下
页:
1
[2]