【飞鸟集】区域查找及foreach的妙用
首先从正交区域查找开始：
在很多情况下数据库的查询都可以转化为正交区域查找，在此先提供一个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 (carcorpt1) b (carcorpt2) 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 (>= (carn) a)
(<= (carn) 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函数，而不是用循环函数。
抛砖引玉，希望大家提提意见。
<P>楼主 用什么方法可以来判断点在是否不规则多边形里面的(比如有弧的 样条曲线.....)</P>
<P>讨论一下</P> <P>将所有对像都近似的拟合成多边形就好了。我就是这么做的。效果非常好。比用CAD的特性计算快一些。</P> <P>楼主 你的程序对于带弧的多边形效果不好 你的程序里面好象没有拟合把??</P>
<P>还有1个问题</P>
<P>;;判断点是否在多边形内-------------感谢狂刀!<BR>(defun ptinpm (pt lst)<BR> (equal<BR> PI<BR> (abs<BR> (apply<BR> '+<BR> (mapcar '(lambda (x y) (rem (- (angle pt x) (angle pt y)) PI))<BR> (cons (last lst) lst)<BR> lst<BR> )<BR> )<BR> )<BR> 1e-6<BR> )<BR>)</P>
<P>这段代码你能帮我解释一下吗?(我对这个算法没理解),我个人是用另外一种方法来求点是否在多边形内部. 没有这个方法代码简单 </P> <P>的确如此，如果多边形有弧段的话，我还没有想出好的解决办法。正在解决中。</P>
<P>关于上段代码，参考了晓东网站狂刀的，请关注他的帖子。</P> 楼主帮我个忙 你把狂刀的帖子的链接给我一下 我在晓东望站里面找了好久没找到 不清楚是在哪个版块 相信你比较清楚 谢过了!! <P><A href="http://www.xdcad.net/forum/showthread.php?s=&postid=2499761#post2499761" target="_blank" >http://www.xdcad.net/forum/showthread.php?s=&postid=2499761#post2499761</A></P>
<P><A href="Archive_view.asp?boardID=3&ID=49681" target="_blank" >Archive_view.asp?boardID=3&ID=49681</A></P>
<P>这里面已经解决了点在曲线内的大部分问题了，但还有一小点没有解决</P>
<P>我正在研究中 。</P> 本帖最后由 llsheng_73 于 2015-8-24 19:18 编辑
highflybir 发表于 2006-11-27 20:17 static/image/common/back.gif
http://www.xdcad.net/forum/showthread.php?s=&postid=2499761#post2499761
Archive_view.asp?boardID=3 ...
不是问题的问题：点与封闭曲线关系可简化至点与三角形关系？
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=169125&fromuid=202795
请大神看下这个判断点与非自交封闭曲线关系的办法，自己只测试过带弧线的多线段，圆，椭圆，对于样条曲线没进行测试 看看效果怎么样 厉害
页:
[1]
2