【飞鸟集】区域查找及foreach的妙用

highflybir · 发表于 2006-11-22 20:16:00

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

;;;*****************************************
;;;定义查找函数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)
)
)

;;;***************************************** 
;;;定义查找函数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 (
  (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) 
  ) 
)

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

tchen · 发表于 2006-11-25 11:45:00

楼主用什么方法可以来判断点在是否不规则多边形里面的(比如有弧的样条曲线.....)

讨论一下

tcsl9621 · 发表于 2006-11-25 13:50:00

将所有对像都近似的拟合成多边形就好了。我就是这么做的。效果非常好。比用CAD的特性计算快一些。

tchen · 发表于 2006-11-25 23:19:00

楼主你的程序对于带弧的多边形效果不好你的程序里面好象没有拟合把??

还有1个问题

;;判断点是否在多边形内-------------感谢狂刀!
(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
)
)

这段代码你能帮我解释一下吗?(我对这个算法没理解),我个人是用另外一种方法来求点是否在多边形内部. 没有这个方法代码简单

highflybir · 发表于 2006-11-26 14:16:00

的确如此，如果多边形有弧段的话，我还没有想出好的解决办法。正在解决中。

关于上段代码，参考了晓东网站狂刀的，请关注他的帖子。

tchen · 发表于 2006-11-26 20:42:00

楼主帮我个忙你把狂刀的帖子的链接给我一下我在晓东望站里面找了好久没找到不清楚是在哪个版块相信你比较清楚谢过了!!

highflybir · 发表于 2006-11-27 20:17:00

http://www.xdcad.net/forum/showthread.php?s=&postid=2499761#post2499761

Archive_view.asp?boardID=3&ID=49681

这里面已经解决了点在曲线内的大部分问题了，但还有一小点没有解决

我正在研究中。

llsheng_73 · 发表于 2015-8-24 19:16:23

本帖最后由 llsheng_73 于 2015-8-24 19:18 编辑

highflybir 发表于 2006-11-27 20:17
http://www.xdcad.net/forum/showt ... 2499761#post2499761
Archive_view.asp?boardID=3 ...

不是问题的问题：点与封闭曲线关系可简化至点与三角形关系？
http://bbs.mjtd.com/forum.php?mo ... &fromuid=202795
请大神看下这个判断点与非自交封闭曲线关系的办法，自己只测试过带弧线的多线段，圆，椭圆，对于样条曲线没进行测试

583775698 · 发表于 2018-8-18 16:52:23

看看效果怎么样

guankuiwu · 发表于 2021-2-14 15:43:51

厉害

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

[【高飞鸟】] 【飞鸟集】区域查找及foreach的妙用

本帖子中包含更多资源

本帖被以下淘专辑推荐:

浏览过的版块