根据Z坐标高差值进行点表分组

wide

请教各位大佬，如何根据Z坐标高差值进行点表分组，比如下表，根据Z坐标高差是400（可更改）进行分组，分组后为'( ( (0 0 0) (0 0 100) (0 100 200)(0 500 400)(0 0 500)(100 0 800)) ((0 0 1200)(0 0 1500)) ((0 0 3200)(0 0 3300)) )，即( (0 0 0) (0 0 100) (0 100 200)(0 500 400)(0 0 500)(100 0 800))为一组，((0 0 1200)(0 0 1500))为一组，((0 0 3200)(0 0 3300))为一组，共3组组成的新表。

• '((0 0 0) (0 0 100)(0 0 500)(0 0 1200)(0 100 200)(0 0 1500)(0 0 3200)(100 0 800)(0 500 400)(0 0 3300))
  

luqzcm

http://bbs.mjtd.com/forum.php?mo ... 0%F2%2B%D6%B1%CF%DF
这里楼主发的源码中的排序子函数可用

看错了，没看到还要分组。

补充一下我的想法：先排序，然后根据各元素Z的差值分割数若干个子表，然后在list在一起。

xyp1964

1. (defun abc (ptn dz)
   
2.   ;; (abc '((0 0 0) (0 0 100)(0 0 500)(0 0 1200)(0 100 200)(0 0 3200)(100 0 800)(0 500 400)) 400)
   
3.   ;; → (((0 0 0) (0 0 100) (0 100 200)) ((0 500 400) (0 0 500)) ((100 0 800)) ((0 0 1200)) ((0 0 3200)))
   
4.   (setq ptn (vl-sort ptn '(lambda (x y) (< (last x) (last y))))
   
5.         ptn (mapcar '(lambda (x) (list (fix (/ (last x) dz)) x)) ptn)
   
6.   )
   
7.   (mapcar '(lambda (x) (apply 'append (cdr x))) (xyp-Count1 ptn))
   
8. )

(defun abc (ptn dz)<br />   ;; (abc '((0 0 0) (0 0 100)(0 0 500)(0 0 1200)(0 100 200)(0 0 3200)(100 0 800)(0 500 400)) 400)<br />   ;; → (((0 0 0) (0 0 100) (0 100 200)) ((0 500 400) (0 0 500)) ((100 0 800)) ((0 0 1200)) ((0 0 3200)))<br />   (setq ptn (vl-sort ptn '(lambda (x y) (< (last x) (last y))))<br />         ptn (mapcar '(lambda (x) (list (fix (/ (last x) dz)) x)) ptn)<br />   )<br />   (mapcar '(lambda (x) (apply 'append (cdr x))) (xyp-Count1 ptn))<br /> )

xyp1964

1. (defun abc (ptn dz / p1 p2 tmp new)
   
2.   "以Z值差分组"
   
3.   ;; (abc '((0 0 0) (0 0 100)(0 0 500)(0 0 1200)(0 100 200)(0 0 3200)(100 0 800)(0 500 400)) 400)
   
4.   ;; → (((0 0 0) (0 0 100) (0 100 200) (0 500 400) (0 0 500) (100 0 800)) ((0 0 1200)) ((0 0 3200)))
   
5.   (setq ptn  (vl-sort ptn '(lambda (x y) (< (last x) (last y))))
   
6.         p1   (car ptn)
   
7.         ptn  (cdr ptn)
   
8.         tmp (list p1)
   
9.   )
   
10.   (while (setq p2 (car ptn))
    
11.     (setq ptn (cdr ptn))
    
12.     (if (< (- (caddr p2) (caddr p1)) dz)
    
13.       (setq tmp (cons p2 tmp))
    
14.       (setq new  (cons (reverse tmp) new)
    
15.             tmp (list p2)
    
16.       )
    
17.     )
    
18.     (setq p1 p2)
    
19.   )
    
20.   (reverse (cons (reverse tmp) new))
    
21. )

(defun abc (ptn dz / p1 p2 tmp new)<br />   "以Z值差分组"<br />   ;; (abc '((0 0 0) (0 0 100)(0 0 500)(0 0 1200)(0 100 200)(0 0 3200)(100 0 800)(0 500 400)) 400)<br />   ;; → (((0 0 0) (0 0 100) (0 100 200) (0 500 400) (0 0 500) (100 0 800)) ((0 0 1200)) ((0 0 3200)))<br />   (setq ptn  (vl-sort ptn '(lambda (x y) (< (last x) (last y))))<br />         p1   (car ptn)<br />         ptn  (cdr ptn)<br />         tmp (list p1)<br />   )<br />   (while (setq p2 (car ptn))<br />     (setq ptn (cdr ptn))<br />     (if (< (- (caddr p2) (caddr p1)) dz)<br />       (setq tmp (cons p2 tmp))<br />       (setq new  (cons (reverse tmp) new)<br />             tmp (list p2)<br />       )<br />     )<br />     (setq p1 p2)<br />   )<br />   (reverse (cons (reverse tmp) new))<br /> )

香远益清

不错，想的很周到，高手在民间啊

tangweinbs

感谢分享，学习一下。

llsheng_73

1. (defun tt(lst n / l)
   
2.   (foreach a(setq lst(vl-sort lst(function(lambda(a b)(<(last a)(last b))))))
   
3.     (if(and l(equal(last(caar l))(last a)n))
   
4.       (setq l(cons(cons a(car l))(cdr l)))
   
5.       (setq l(cons(list a)l))))
   
6.   (mapcar(function reverse)(reverse l))
   
7.   )

(defun tt(lst n / l)<br />   (foreach a(setq lst(vl-sort lst(function(lambda(a b)(<(last a)(last b))))))<br />     (if(and l(equal(last(caar l))(last a)n))<br />       (setq l(cons(cons a(car l))(cdr l)))<br />       (setq l(cons(list a)l))))<br />   (mapcar(function reverse)(reverse l))<br />   )

llsheng_73

xyp1964 发表于 2024-12-19 18:25

看错要求了，院长这个是对的。。。