[原创]：区域查找及foreach 的妙用

highflybird

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

2. [color=green]
   
3. ;;;*****************************************
   
4. ;;;定义查找函数2，并获得每个点的坐标和原编号
   
5. (defun search (ptlist pl / pp ex)
   
6.   (setq pp nil)
   
7.   (foreach n ptlist
   
8.     (if        (ptinpm n pl)
   
9.       (setq pp (cons n pp))
   
10.     )
    
11.   )
    
12.   pp
    
13. )
    
14. ;;;*****************************************
    
15. [/color]

[color=green]<br /> ;;;*****************************************<br /> ;;;定义查找函数2，并获得每个点的坐标和原编号<br /> (defun search (ptlist pl / pp ex)<br />   (setq pp nil)<br />   (foreach n ptlist<br />     (if        (ptinpm n pl)<br />       (setq pp (cons n pp))<br />     )<br />   )<br />   pp<br /> )<br /> ;;;*****************************************<br /> [/color]

现在我要讨论的是：显然对于正交区域查找 ，用CAD的选择集方法亦可实现，但CAD选择集有BUG，注意看了，下面的图中，黄色的点是用查找函数找出来的点，而用选择集的点除了包含黄色的点外，还选择了查找区域外的点（红色的点），而且在选择的时候用'zoom等命令，很可能会出错，因而不精确，甚至是错误的（我已编写了这方面的程序验证了）。
另外用选择集的方法显然对于一些是样条曲线的多边形不能完成，而且，也不能适应自交叉的问题。
这个程序没有涉及到算法，但还是很快的。对于正交查找，100万个点3、4秒钟可完成，跟用选择集的时间相差无几。为什么这么快，归根于用了foreach函数，而不是用循环函数。
抛砖引玉，希望大家提提意见。
[php];;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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 obj (vlax-ename->vla-object ename))
      (vla-GetBoundingBox obj 'minpt 'maxpt)
      (setq minpt (vlax-safearray->list minpt)
            maxpt (vlax-safearray->list maxpt)
      )
      (setq a (car  minpt)
            b (car  maxpt)
            c (cadr minpt)
            d (cadr maxpt)
      )
      (setq ptlist1 (search1 ptlist a b c d))
      (setq pl (xdl-pl-vertexs ename))
      ;;查找区域中的点并对用时进行估算------
      (setq t0 (getvar "TDUSRTIMER"))
      (setq pp (search ptlist1 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)
        )
      )
    )
  )
)
;;;*****************************************
;;;定义查找函数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
)
;;;*****************************************
;;;定义查找函数2，并获得每个点的坐标和原编号
(defun search (ptlist pl / pp ex)
  (setq pp nil)
  (foreach n ptlist
    (if        (ptinpm n pl)
      (setq pp (cons n pp))
    )
  )
  pp
)
;;;*****************************************
;;依据晓东网站的代码改写而成的取点函数------
(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
  )
)
[/php]
highflybird@sina.com
http://p4.xdcad.net/forum/attachment.php?s=&postid=3085830

                               
登录/注册后可看大图

                               
登录/注册后可看大图