[讨论]：关于删除一坐标点列表中x或y坐标值相同的元素

lzy9788

请教各位一个问题，怎么用lisp实现删除点列表x或y坐标值相同的点。或是用vl-remove。
最好有用lisp实现的。不知道哪位大侠有这个程序。

playboy

那个函数不行的
我试过

lzy9788

用lisp了，能实现吗

陌生人

最初由 playboy 发布
[B]那个函数不行的
我试过 [/B]

为什么不行？

playboy

如果节点有重复的
不能合理的判断替换哪一个坐标
所以不行的

陌生人

怎么才算合理？

lsjjm

最初由 lzy9788 发布
[B]请教各位一个问题，怎么用lisp实现删除点列表x或y坐标值相同的点。或是用vl-remove。
最好有用lisp实现的。不知道哪位大侠有这个程序。 [/B]

说说具体要求, 是都删除还是保留哪一个?

lijiao

2. 
   
3.   [FONT=courier new]
   
4. (defun del_tpt (lst jd / my_lst item lst1)
   
5.   (setq my_lst '())
   
6.   (while (> (length lst) 0)
   
7.     (setq my_lst (cons (car lst) my_lst)
   
8.         lst (cdr lst))
   
9.     (setq lst1 lst)
   
10.     (foreach item lst1
    
11.       (if (equal (car my_lst) item jd)
    
12.         (setq  lst (vl-remove item lst))
    
13.         )
    
14.       )
    
15.     )
    
16.   (reverse my_lst)
    
17.   )
    
18.   [/FONT]
    

<br />   [FONT=courier new]<br /> (defun del_tpt (lst jd / my_lst item lst1)<br />   (setq my_lst '())<br />   (while (> (length lst) 0)<br />     (setq my_lst (cons (car lst) my_lst)<br />         lst (cdr lst))<br />     (setq lst1 lst)<br />     (foreach item lst1<br />       (if (equal (car my_lst) item jd)<br />         (setq  lst (vl-remove item lst))<br />         )<br />       )<br />     )<br />   (reverse my_lst)<br />   )<br />   [/FONT]<br />

lzy9788

要保留其中一个
to 青铜长老，我有一愚问：你的那个jd是个什么……，在测试时我不会用这个jd.

lsjjm

最初由 lijiao 发布
[B][CODE]
  
(defun del_tpt (lst jd / my_lst item lst1)
  (setq my_lst '())
  (while (> (length lst) 0)
    (setq my_lst (cons (car lst) my_lst)
        lst (cdr lst))
    (setq lst1 lst)
    (foreach item lst1
      (if (equal (car my_lst) item jd)
        (setq  lst (vl-remove item lst))
        )
      )
    )
  (reverse my_lst)
  ) [/B]

此程序有误: (equal (car my_lst) item jd)应该为
(if (equal (car (car my_lst))(car item) jd)

lijiao

最初由 lzy9788 发布
[B]要保留其中一个
to 青铜长老，我有一愚问：你的那个jd是个什么……，在测试时我不会用这个jd. [/B]

JD就是精度，比如（1.00001 2 3）和（1.001 2 3）是否是重合的点？
＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
TO LSJJM：程序没有错误，不知你是否测试过，这是我的测试：

2. 
   
3.   [FONT=courier new]
   
4. _$ (setq pt '((0 0 0.001) (0 0 0) (0 0 0) (0 0 0) (1 1 1) (1 1 1) (2 2 2)))
   
5. ((0 0 0.001) (0 0 0) (0 0 0) (0 0 0) (1 1 1) (1 1 1) (2 2 2))
   
6. _$ (del_tpt pt 0.001)
   
7. ((0 0 0.001) (0 0 0) (1 1 1) (2 2 2))
   
8. _$ (del_tpt pt 0.01)
   
9. ((0 0 0.001) (1 1 1) (2 2 2))  [/FONT]
   

<br />   [FONT=courier new]<br /> _$ (setq pt '((0 0 0.001) (0 0 0) (0 0 0) (0 0 0) (1 1 1) (1 1 1) (2 2 2)))<br /> ((0 0 0.001) (0 0 0) (0 0 0) (0 0 0) (1 1 1) (1 1 1) (2 2 2))<br /> _$ (del_tpt pt 0.001)<br /> ((0 0 0.001) (0 0 0) (1 1 1) (2 2 2))<br /> _$ (del_tpt pt 0.01)<br /> ((0 0 0.001) (1 1 1) (2 2 2))  [/FONT]<br />

陌生人

深一层car就是将x相同的点排除，而不是在精度内x，y，z相同的点

dicck

顶

lsjjm

最初由 lijiao 发布
[B].....TO LSJJM：程序没有错误，不知你是否测试过...[/B]

1. 没有测试过怎么gan说呀?
(setq pt '((0 0 0.001) (0 0 0) (0 0 0) (0 0 0) (1 1 1) (1 1 1) (2 2 2)))
jd =0.001
测试结果: ((0 0 0.001) (0 0 0) (1 1 1) (2 2 2))
将程序中(equal (car my_lst) item jd) 改为(if (equal (car (car my_lst))(car item) jd)返回正确结果:((0 0 0.001) (1 1 1) (2 2 2))
2. 从函数和表达式内容和逻辑意义看, lst /my_lst是点表, 那么(car my_lst) 就是一个点, (equal (car my_lst) item jd) 判别的是两个点是否相等(重合). 而不是1楼楼主说的x/y坐标值相同.
3. 如果是删除重合点使用acet函数更简单:
(defun del_tpt (lst jd )
   (acet-list-remove-duplicates lst jd)
)
返回和你程序相同结果.

lzy9788

(SETQ PTS '((121.158 252.669 0.0) (121.158 89.6678 0.0) (374.959 252.669 0.0) (374.959 89.6678 0.0)))
(SETQ PT (del_tpt PTS 0.01))
这样求出来的PT并没有除掉X坐标相同的项。
请长老看看.
按lsjjm 的就能达到我要的效果了。
多谢两位长老相助。