区域查找及foreach的妙用

Highflybird

首先从正交区域查找开始：
在很多情况下数据库的查询都可以转化为正交区域查找，在此先提供一个lisp程序，用来查找二维的点集落在某区域（a<=x<=b,c<=y<=d）的点集。
加载程序运行te1 ,然后选择点集，指定要查找的区域，（左下角和右上角点），这样就可以看到有哪些点找到了。代码在附件上。为：serachrec.lsp
接着我编了另外一个程序，不仅满足正交区域查找，对于多边形区域同样有效。（多边形可以为直线段的，也可以自相交的，可以是样条曲线的，但不能包含圆弧段，否则不准确）
运行te2 ，然后选择多边形，即可找出在这个多边形内的点。

[pcode=lisp,true]
;;;*****************************************
;;;定义查找函数2，并获得每个点的坐标和原编号
(defun search (ptlist pl / pp ex)
  (setq pp nil)
  (foreach n ptlist
    (if (ptinpm n pl)
      (setq pp (cons n pp))
    )
  )
  pp
)
;;;*****************************************
(defun C:te2 (/ olderr en errmsg oldmode oce sl ss ss1 ename t0 ptlist pp)
  ;;定义错误函数和预处理--------------------
  (setvar "errno" 0)
  (setq olderr *error*)
  (defun *error* (msg)
    (setq en (getvar "errno"))
    (setq errmsg (strcat "errno=" (itoa en) "\nError:" msg))
    (alert errmsg)
    (setq *error* olderr)
  )
  (graphscr)
  (setq oldmode (getvar "osmode"))
  (setq oce (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (command ".ucs" "W")
  ;;也可以用其他方式取得点集----------------
  (setq sl '((0 . "POINT")))
  (setq ss (ssget sl))
  (setq t0 (getvar "TDUSRTIMER"))
  (setq ptlist (getpt ss))
  (princ "\n构造点集用时")
  (princ (* (- (getvar "TDUSRTIMER") t0) 86400))
  (princ "秒")
  (command "_.change" ss "" "P" "C" "BYL" "")
  (princ "\n请选择多边形:")
  (setq ss1 (ssget ":S" '((-4 . "<OR")(0 . "POLYLINE")(0 . "LWPOLYLINE")(-4 . "OR>"))))
  (setq ename (if (= ss1 nil) nil (ssname ss1 0)))
  (if (= ename nil)
    (progn
      (alert "你没有选择多边形!")
      (command ".ucs" "P")
      (setvar "osmode" oldmode)
      (setvar "cmdecho" oce)
      (princ)
    )
    (progn
      (setq pl (xdl-pl-vertexs ename))
      ;;查找区域中的点并对用时进行估算------
      (setq t0 (getvar "TDUSRTIMER"))
      (setq pp (search ptlist pl))
      (princ "\n查找点用时")
      (princ (* (- (getvar "TDUSRTIMER") t0) 86400))
      (princ "秒")
      (if (= nil pp)
(progn
   (alert "在这个区域没有点集中的点!")
   (command ".ucs" "p")
   (setvar "osmode" oldmode)
   (setvar "cmdecho" oce)
   (princ)
)
(progn
   ;;改变查找出来的点的颜色为红色----
   (setvar "osmode" 0)
   (setq t0 (getvar "TDUSRTIMER"))
   (change-color ss pp 1)
   (princ "\n点变色用时")
   (princ (* (- (getvar "TDUSRTIMER") t0) 86400))
   (princ "秒")
   (command ".ucs" "P")
   (setvar "osmode" oldmode)
   (setvar "cmdecho" oce)
   (princ)
)
      )
    )
  )
)
;;依据晓东网站的代码改写而成的取点函数------
(defun getpt (ss / i listpp a b c)
  (setq i 0 listpp nil)
  (if ss
    (repeat (sslength ss)
      (setq a (ssname ss i)
     b (entget a)
     c (cdr (assoc 10 b))
     c (list (car c) (cadr c) i)
      )
      ;;i用来定义在选择集中的编号，不是Z坐标
      (setq listpp (cons c listpp))
      (setq i (1+ i))
    )
  )
  (reverse listpp)
)
;;定义改变查找到的点的颜色的函数------------
(defun change-color (ss pp color / i)
  (setq i 0)
  (foreach n pp
    (setq a (ssname ss (caddr n)))
    (setq b (entget a))
    (setq b (cons (cons 62 color) b))
    (entmod b)
  )
)
;;取得多边形顶点------------------感谢eachy!
(defun xdl-pl-vertexs (e / n lst)
  (if (= e nil)
    nil
    (progn
      (setq lst
(repeat (setq n (fix (1+ (vlax-curve-getendparam e))))
   (setq lst (cons (vlax-curve-getpointatparam e (setq n (1- n))) lst))
)
      )
      (if (= 0 (cdr (assoc 70 (entget e))))
lst
(cdr lst)
      )
    )
  )
)
;;判断点是否在多边形内-------------感谢狂刀!
(defun ptinpm (pt lst)
  (equal
    PI
    (abs
      (apply
'+
(mapcar '(lambda (x y) (rem (- (angle pt x) (angle pt y)) PI))
  (cons (last lst) lst)
  lst
)
      )
    )
    1e-6
  )
)
(defun C:te1 (/ olderr en errmsg oldmode oce sl ss t0 ptlist pp corpt1 corpt2)
  ;;定义错误函数和预处理--------------------
  (setvar "errno" 0)
  (setq olderr *error*)
  (defun *error* (msg)
    (setq en (getvar "errno"))
    (setq errmsg (strcat "errno=" (itoa en) "\nError:" msg))
    (alert errmsg)
    (setq *error* olderr)
  )
  (graphscr)
  (setq oldmode (getvar "osmode"))
  (setq oce (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (command ".ucs" "W")
  ;;也可以用其他方式取得点集----------------
  (setq sl '((0 . "POINT")))
  (setq ss (ssget sl))
  (setq t0 (getvar "TDUSRTIMER"))
  (setq ptlist (getpt1 ss))
  (princ "\n用时")
  (princ (* (- (getvar "TDUSRTIMER") t0) 86400))
  (princ "秒")
  (command "_.change" ss "" "P" "C" "BYL" "")
  (setq corpt1 (getpoint "\n区域的左下角:"))
  (setq corpt2 (getpoint "\n区域的右上角:"))
  (setq a (car  corpt1) b (car  corpt2) c (cadr corpt1) d (cadr corpt2))
  ;;查找区域中的点并对用时进行估算----------
  (setq t0 (getvar "TDUSRTIMER"))
  (setq pp (search1 ptlist a b c d))
  (princ "\n查找点用时")
  (princ (* (- (getvar "TDUSRTIMER") t0) 86400))
  (princ "秒")
  (if (= nil pp)
    (progn
      (alert "在这个区域没有点集中的点!")
      (command ".ucs" "p")
      (setvar "osmode" oldmode)
      (setvar "cmdecho" oce)
      (princ)
    )
    (progn
      ;;画凸包边界线------------------------
      (setvar "osmode" 0)
      (command ".rectang" corpt1 corpt2)
      (setq t0 (getvar "TDUSRTIMER"))
      (change1-color pp 1)
      (princ "\n点变色用时")
      (princ (* (- (getvar "TDUSRTIMER") t0) 86400))
      (princ "秒")
      (command ".ucs" "P")
      (setvar "osmode" oldmode)
      (setvar "cmdecho" oce)
      (princ)
    )
  )
)
;;;*****************************************
;;;定义查找函数1，并获得每个点的坐标和原编号
(defun search1 (ptlist a b c d / pp ex)
  (if (< b a) (setq ex b b a a ex))
  (if (< d c) (setq ex d d c c ex))
  (setq pp nil)
  (foreach n ptlist
    (if (and (>= (car  n) a)
      (<= (car  n) b)
      (>= (cadr n) c)
      (<= (cadr n) d)
)
      (setq pp (cons n pp))
    )
  )
  pp
)
;;;*****************************************
;;依据晓东网站的代码改写而成的取点函数------
(defun getpt1 (ss / i listpp a b c)
  (setq i 0 listpp nil )
  (if ss
    (repeat (sslength ss)
      (setq a (ssname ss i))
      (setq b (entget a))
      (setq c (cdr (assoc 10 b)))
      (setq c (list (car c) (cadr c) a))
      (setq listpp (cons c listpp))
      (setq i (1+ i))  
    )
  )
  (reverse listpp)
)
;;定义改变颜色函数--------------------------
(defun change1-color (pp color / a b)
  (foreach n pp
    (setq a (caddr n))
    (setq b (entget a))
    (setq b (cons (cons 62 color) b))
    (entmod b)
  )
)
[/pcode]



现在我要讨论的是：显然对于正交区域查找 ，用CAD的选择集方法亦可实现，但CAD选择集有BUG，注意看了，下面的图中，黄色的点是用查找函数找出来的点，而用选择集的点除了包含黄色的点外，还选择了查找区域外的点（红色的点），而且在选择的时候用'zoom等命令，很可能会出错，因而不精确，甚至是错误的（我已编写了这方面的程序验证了）。
另外用选择集的方法显然对于一些是样条曲线的多边形不能完成，而且，也不能适应自交叉的问题。
这个程序没有涉及到算法，但还是很快的。对于正交查找，100万个点3、4秒钟可完成，跟用选择集的时间相差无几。为什么这么快，归根于用了foreach函数，而不是用循环函数。
抛砖引玉，希望大家提提意见。

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:searchrec.lsp 
下载次数:30  文件大小:2.73 KB 
下载权限: 不限 以上  [免费赚D豆]

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:searchpol.lsp 
下载次数:27  文件大小:3.38 KB 
下载权限: 不限 以上  [免费赚D豆]

wowan1314

飞鸟！最近作品井喷呀！
foreach函数如此高效吗？
如果是一个点跟一堆矩形比较，从而确定落在哪个矩形中的问题呢？
这种情况是foreach高效还是循环高效？
因为循环可以在找到矩形后随时停止循环！
正好遇到此问题！

Highflybird

wowan1314 发表于 2013-5-8 00:13

                               
登录/注册后可看大图

飞鸟！最近作品井喷呀！
foreach函数如此高效吗？
如果是一个点跟一堆矩形比较，从而确定落在哪个矩形中的 ...

这个是我以前的想法，现在看来有点不是很好。
实际上区域查找有种时间为log(N)的算法，远比这快。
当然你循环的是一个好办法。