(XD::Pnts:RemoveDup)点表消除重复点

XDSoft · 发表于 2013-11-14 00:30:35

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

;|
消除重复点
参数：
pts ---- 点表
fuzz---- 模糊精度值
返回：点表
|;
(defun XD::Pnts:RemoveDup (pts fuzz / coord oldprec ori x xline xmin y yline ymin)
(setq xMin (apply 'min (mapcar 'car pts))
yMin (apply 'min (mapcar 'cadr pts))
coord (XD::UCS:CoordSys)
ori (list xMin yMin 0.0)
xLine (list ori (mapcar '+ ori (cadr coord)))
yLine (list ori (mapcar '+ ori (caddr coord)))
pts (mapcar
'cdr
(XD::assocList:RemoveDupByNumKey (mapcar
'(lambda (x)
(list (abs
(xdrx_point_dist2line x
(car yLine)
(cadr yLine)
)
) x
)
)
pts
) fuzz
)
) ;;X方向距离相等的构建关联表
pts (mapcar
'car
(mapcar
'(lambda (x)
(mapcar
'car
(mapcar
'cdr
(XD::assocList:RemoveDupByNumKey (mapcar
'(lambda (y)
(list (abs
(xdrx_point_dist2line y
(car xLine)
(cadr xLine)
)
) y
)
)
x
) fuzz
);;X方向相等的字表里面Y方向相等的构建关联表
)
)
)
pts
)
);;只保留CAR，其他重复点
)
pts
)

;| 
消除重复点 
参数： 
   pts ----  点表 
   fuzz----  模糊精度值 
返回：点表 
|; 
(defun XD::Pnts:RemoveDup (pts fuzz / coord oldprec ori x xline xmin y yline ymin) 
  (setq xMin (apply 'min (mapcar 'car pts)) 
        yMin (apply 'min (mapcar 'cadr pts)) 
        coord (XD::UCS:CoordSys) 
        ori (list xMin yMin 0.0) 
        xLine (list ori (mapcar '+ ori (cadr coord))) 
        yLine (list ori (mapcar '+ ori (caddr coord))) 
        pts (mapcar 
              'cdr 
              (XD::assocList:RemoveDupByNumKey  (mapcar 
                                            '(lambda (x) 
                                               (list (abs 
                                                          (xdrx_point_dist2line x 
                                                                                (car yLine) 
                                                                                (cadr yLine) 
                                                          ) 
                                                     ) x 
                                               ) 
                                             ) 
                                            pts 
                                          ) fuzz 
              ) 
            ) ;;X方向距离相等的构建关联表 
        pts (mapcar 
              'car 
              (mapcar 
                '(lambda (x) 
                   (mapcar 
                     'car 
                     (mapcar 
                       'cdr 
                       (XD::assocList:RemoveDupByNumKey  (mapcar 
                                                     '(lambda (y) 
                                                        (list (abs 
                                                                   (xdrx_point_dist2line y 
                                                                                         (car xLine) 
                                                                                         (cadr xLine) 
                                                                   ) 
                                                              ) y 
                                                        ) 
                                                      ) 
                                                     x 
                                                   ) fuzz 
                       );;X方向相等的字表里面Y方向相等的构建关联表 
                     ) 
                   ) 
                 ) 
                pts 
              ) 
            );;只保留CAR，其他重复点 
  ) 
  pts 
)

st788796 · 发表于 2013-11-14 05:31:25

本帖最后由 st788796 于 2013-11-14 05:35 编辑

一般这样写

(defun XD::Pnts:RemoveDup (pts fuzz / ptl)
(setq ptl (car pts))
(while (setq pts (cdr pts)
pts (vl-remove-if '(lambda (p) (equal p (car ptl) fuzz)) pts))
(setq ptl (cons (car pts) ptl))
)
(reverse ptl)
)
)

XDSoft · 发表于 2013-11-14 07:48:49

st788796 发表于 2013-11-14 05:31
一般这样写

你这个要N方，通过排序，能转化到N级别。

口味虾 · 发表于 2013-11-14 07:52:35

感谢老大的回复这么晚了还回复者及时，并且还专门写了这长的代码，不过我测试了下这个函数貌似不能工作。 (XD::Pnts:RemoveDup (list '(1 0 0) '(2 0 0) '1(1 0 0)) 0) 就根本没有返回值

XDSoft · 发表于 2013-11-14 08:08:21

口味虾发表于 2013-11-14 07:52
感谢老大的回复这么晚了还回复者及时，并且还专门写了这长的代码，不过我测试了下这个函数貌似不能工作。 ...

你参数不都是点，能对吗

(list '(1 0 0) '(2 0 0) '1(1 0 0))
- 本文出自晓东CAD家园-论坛，原文地址：http://bbs.xdcad.net/thread-671604-1-1.html

怎么有个 ‘1

守仁格竹GM · 发表于 2013-11-14 08:11:51

本帖最后由守仁格竹GM 于 2013-11-14 08:14 编辑

看楼下吧刚才回复对象搞错了

守仁格竹GM · 发表于 2013-11-14 08:13:46

st788796 发表于 2013-11-14 05:31
一般这样写

(defun XD:nts:RemoveDup (ptLst fuzz / p pl)
  (while ptLst
(setq p (car ptLst)
pl (cons p pl)
ptLst (vl-remove-if
'(lambda (x) (equal p x fuzz))
ptLst
)
)
  )
  (reverse pl)
)
我觉得这样计算看上去差不多但是应该会减少很多重复判断的步骤。

newer · 发表于 2013-11-14 08:27:04

守仁格竹GM 发表于 2013-11-14 08:13
(defun XD:nts:RemoveDup (ptLst fuzz / p pl)
(while ptLst
(setq p (car ptLst)

vl-remove-if这个函数要遍历整个表的，所以这个算法的时间效率上应该是N平方级的

st788796 · 发表于 2013-11-14 08:29:47

本帖最后由 st788796 于 2013-11-14 08:38 编辑

newer 发表于 2013-11-14 08:27
vl-remove-if这个函数要遍历整个表的，所以这个算法的时间效率上应该是N平方级的

对一般来说 vl 函数的效率足够了，原来离的近的点在排序后在表中位置可能有离的远了，这是有过实例的
最坏的情况是N的平方，vl-remove 后 lst 的长度可能是逐步缩短的

newer · 发表于 2013-11-14 09:01:14

本帖最后由 newer 于 2013-11-14 09:03 编辑

st788796 发表于 2013-11-14 08:29
对一般来说 vl 函数的效率足够了，原来离的近的点在排序后在表中位置可能有离的远了，这是有过实例的
最 ...

不管，vl-remove的效率如何，那怕它秒杀，但如果把他放到一个两次循环的内部，那整个时间上还是慢的。这个是算法的时间，和单个函数无关。

如果能走一次N，就把X方向距离相等的都放到一起，再走一个N，再把X相等的里面的Y相等的在放一起。然后哪怕再用你上面写的N方的函数分别对排序后的表再操作，这个时间也应该是质的提升的。你可以试试。

st788796 · 发表于 2013-11-14 09:02:56

newer 发表于 2013-11-14 09:01
不管，vl-remove的效率如何，那怕它秒杀，但如果把他放到一个两次循环的内部，那整个时间上还是慢的。这 ...

这个不能放循环里的,即使在循环内, lst 的数量级不会大的:)

newer · 发表于 2013-11-14 09:06:35

st788796 发表于 2013-11-14 09:02
这个不能放循环里的,即使在循环内, lst 的数量级不会大的

你现在这个写法，本身就是N2级别的。两个整表两辆元素比较。

你试试先排序下，然后用你的函数对小表操作，看看时间是不是质的提升。因为通过排序，把不可能相等的无关的都排除掉了。

st788796 · 发表于 2013-11-14 09:09:49

newer 发表于 2013-11-14 09:06
你现在这个写法，本身就是N2级别的。两个整表两辆元素比较。

你试试先排序下，然后用你的函数对小表操 ...

这个排序不能用 xyz 排序，以前用 xyz 排序后发现有问题才用这个简单方法，懒得再去深究{:soso_e113:}

口味虾 · 发表于 2013-11-14 09:36:50

XDSoft 发表于 2013-11-14 08:08
你参数不都是点，能对吗

(list '(1 0 0) '(2 0 0) '1(1 0 0))

抱歉回复贴的时候笔误，不过我这这个函数确实不能运行。

st788796 · 发表于 2013-11-14 09:43:59

本帖最后由 st788796 于 2013-11-14 09:47 编辑

这个不排序直接用 vl-remove-if 在数量大的时候 CAD会死掉，不过这样写了下, 用 XD::List:GroupByIndex

(defun Pnts:RemoveDup (pts fuzz / pj ptl)
(setq pj (car (apply 'xdrx_points_box pts))
ptl (mapcar '(lambda (x) (list (distance x pj) x)) pts)
ptl (xd::list:groupbyindex ptl fuzz)
)
(mapcar 'cadr ptl)
)
(defun getutime () (* 86400 (getvar "tdusrtimer")))
(defun c:tt (/ ss pts pts1 t0)
(if (setq ss (ssget '((0 . "point"))))
(progn
(setq pts (mapcar '(lambda (x) (xdrx_getpropertyvalue x "Position"))
(xdrx_pickset->ents ss)
)
t0 (getutime)
)
(setq pts1 (Pnts:Removedup pts 0.0001))
(princ (- (getutime) t0))
(princ "\n")
(princ (- (length pts1) (length pts)))
)
)
(princ)
)

命令: TT
选择对象: 指定对角点: 找到 39312 个

选择对象:
0.795
-21

没有处理子表！

账号		自动登录	找回密码
密码			立即注册

[点表] (XD::Pnts:RemoveDup)点表消除重复点

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

点评

点评

点评

点评

点评

点评

点评

点评

点评

点评