又遇到一个表处理难题，请高手解决。顺带学习学习。

gaics

`中微子 发表于 2023-8-15 16:16
请看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

1. (setq waco1
   
2. '((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)))
   
3. (princ "原表:")(princ waco1)
   
4. ;; 按色号排序并分组
   
5. (setq waco1 (vl-sort
   
6.               waco1
   
7.               '(lambda (x y)
   
8.                  (<
   
9.                    (last x)
   
10.                    (last y)))))
    
11. (setq waco1 (list:group-by
    
12.               waco1
    
13.               '(lambda (x y)
    
14.                  (=
    
15.                    (last x)
    
16.                    (last y)))))
    
17. ;; 组内起点从小到大排序
    
18. (setq waco1 (mapcar
    
19.               '(lambda (x)
    
20.                  (vl-sort
    
21.                    x
    
22.                    '(lambda (m n)
    
23.                       (< (car m) (car n)))))
    
24.               waco1))
    
25. ;; (princ "\n排序表:")(princ waco1)
    
26. 
    
27. ;; 合并同色且连续的，即前一个的起点+长度 >= 紧临表的起点
    
28. (defun join-line (lst / res fuzz)
    
29.   (setq fuzz 0.01)
    
30.   (setq res (cons (car lst) nil))
    
31.   (while (setq lst (cdr lst))
    
32.     (if
    
33.       (and
    
34.         (setq f (car res))
    
35.         (>= (+ (+ (car f) (cadr f)) fuzz) (caar lst)))
    
36.       (setq res (cons
    
37.                   (list
    
38.                     (caar res)
    
39.                     (max
    
40.                       (+ (cadar lst) (- (caar lst) (caar res)))
    
41.                       (cadar res))
    
42.                     (last (car res)))
    
43.                   (cdr res)))
    
44.       (setq res (cons (car lst) res))))
    
45.   (reverse res)
    
46. )
    
47. (princ "\n结果:")(princ (apply 'append (mapcar 'join-line waco1)))
    
48. (princ)

(setq waco1 <br /> '((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)))<br /> (princ "原表:")(princ waco1)<br /> ;; 按色号排序并分组<br /> (setq waco1 (vl-sort <br />               waco1<br />               '(lambda (x y) <br />                  (< <br />                    (last x)<br />                    (last y)))))<br /> (setq waco1 (list:group-by <br />               waco1<br />               '(lambda (x y) <br />                  (= <br />                    (last x)<br />                    (last y)))))<br /> ;; 组内起点从小到大排序<br /> (setq waco1 (mapcar <br />               '(lambda (x) <br />                  (vl-sort <br />                    x<br />                    '(lambda (m n) <br />                       (< (car m) (car n)))))<br />               waco1))<br /> ;; (princ "\n排序表:")(princ waco1)<br /> <br /> ;; 合并同色且连续的，即前一个的起点+长度 >= 紧临表的起点<br /> (defun join-line (lst / res fuzz) <br />   (setq fuzz 0.01)<br />   (setq res (cons (car lst) nil))<br />   (while (setq lst (cdr lst)) <br />     (if <br />       (and <br />         (setq f (car res))<br />         (>= (+ (+ (car f) (cadr f)) fuzz) (caar lst)))<br />       (setq res (cons <br />                   (list <br />                     (caar res)<br />                     (max <br />                       (+ (cadar lst) (- (caar lst) (caar res)))<br />                       (cadar res))<br />                     (last (car res)))<br />                   (cdr res)))<br />       (setq res (cons (car lst) res))))<br />   (reverse res)<br /> )<br /> (princ "\n结果:")(princ (apply 'append (mapcar 'join-line waco1)))<br /> (princ)

非得有现成的函数才会用容差吗？
(>= (+ (+ (car f) (cadr f)) fuzz) (caar lst)))

`中微子

vitalgg 发表于 2023-8-16 06:53
非得有现成的函数才会用容差吗？
(>= (+ (+ (car f) (cadr f)) fuzz) (caar lst)))

谢谢！高手的代码改起来一下子糊涂了

tangjuntao

overkill命令用一下