[LISP程序]：判断点表是否共线

snsj

2. 
   
3. ;;;|判断点表是否共线
   
4. (defun pd-ptlst-gx (lst / pt1 pt2 x dst1 dst2 pd ang)
   
5.   (setq ang (+ (angle (car lst) (cadr lst)) (/ pi 2)))
   
6.   (setq        pt2 (polar (setq pt1 (car lst)) ang 1e+3)
   
7.         pd  t
   
8.   )
   
9.   (mapcar
   
10.     '(lambda (x)
    
11.        (if (not        (equal (distance x pt2)
    
12.                        (sqrt (+        (* (setq dst1 (distance x pt1)) dst1)
    
13.                                 (* (setq dst2 (distance pt1 pt2)) dst2)
    
14.                              )
    
15.                        )
    
16.                        1e-3
    
17.                 )
    
18.            )
    
19.          (setq pd nil)
    
20.        )
    
21.      )
    
22.     (vl-remove (car lst) lst)
    
23.   )
    
24.   pd
    
25. )
    

<br /> ;;;|判断点表是否共线<br /> (defun pd-ptlst-gx (lst / pt1 pt2 x dst1 dst2 pd ang)<br />   (setq ang (+ (angle (car lst) (cadr lst)) (/ pi 2)))<br />   (setq        pt2 (polar (setq pt1 (car lst)) ang 1e+3)<br />         pd  t<br />   )<br />   (mapcar<br />     '(lambda (x)<br />        (if (not        (equal (distance x pt2)<br />                        (sqrt (+        (* (setq dst1 (distance x pt1)) dst1)<br />                                 (* (setq dst2 (distance pt1 pt2)) dst2)<br />                              )<br />                        )<br />                        1e-3<br />                 )<br />            )<br />          (setq pd nil)<br />        )<br />      )<br />     (vl-remove (car lst) lst)<br />   )<br />   pd<br /> )<br />

狂刀

2. 
   
3.   [FONT=courier new]
   
4. ;; xdl-ptsonline 判断点集共线.----by 狂刀.2005.10
   
5.   (defun xdl-ptsonline (lst de)
   
6. (or
   
7.   (< (length lst) 3)
   
8.   (not(setq lst (append lst (list (car pts)(cadr pts)))));;修补aeo在3楼提出的bug
   
9.   (apply 'and
   
10.          (mapcar '(lambda (a b c / ab ac bc)
    
11.                     (setq ab (distance a b)
    
12.                           ac (distance a c)
    
13.                           bc (distance b c)
    
14.                     )
    
15.                     (equal (* 2 (max ab ac bc)) (+ ab ac bc) de)
    
16.                   )
    
17.                  lst
    
18.                  (cdr lst)
    
19.                  (cddr lst)
    
20.          )
    
21.   ))
    
22. )
    
23.   [/FONT]
    

<br />   [FONT=courier new]<br /> ;; xdl-ptsonline 判断点集共线.----by 狂刀.2005.10<br />   (defun xdl-ptsonline (lst de)<br /> (or <br />   (< (length lst) 3)<br />   (not(setq lst (append lst (list (car pts)(cadr pts)))));;修补aeo在3楼提出的bug<br />   (apply 'and<br />          (mapcar '(lambda (a b c / ab ac bc)<br />                     (setq ab (distance a b)<br />                           ac (distance a c)<br />                           bc (distance b c)<br />                     )<br />                     (equal (* 2 (max ab ac bc)) (+ ab ac bc) de)<br />                   )<br />                  lst<br />                  (cdr lst)<br />                  (cddr lst)<br />          )<br />   ))<br /> )<br />   [/FONT]<br />

狂刀

最初由 aeo 发布

(xdl-ptsonline '((0. 0. 0.)(1. 1. 0.)(1. 1. 10.)(1. 1. -10.)) 1e-4)
－》 T？

eachy

aeo 的程序判断是 2D 点，不过点集操作中，无序的点集对 Lisp 处理是没有多少意义的。

taner

[PHP](defun radtoang (n)
  (/ (* 180 n) pi)
)
(defun ptsonline (ptlist / angle01 i j yesorno)
  (if (> (setq i (length ptlist))
         2
      )
    (progn
      (setq angle01 (radtoang (angle (nth 0 ptlist) (nth 1 ptlist))))
      (setq j 2)
      (while (< j i)
        (if (or
              (equal (abs (- angle01 (radtoang (angle (nth 0 ptlist)
                                                  (nth j ptlist)
                                           )
                                 )
                      )
                 ) 180 1e-10

              )
              (equal (abs (- angle01 (radtoang (angle (nth 0 ptlist)
                                                  (nth j ptlist)
                                           )
                                 )
                      )
                 ) 0 1e-10

              )
            )
          (setq yesorno t)
          (setq yesorno nil)
        )
        (if yesorno
          (setq j (1+ j))
          (setq j i)
        )
      )
      yesorno
    )   
(princ "\n点集内元素少于3个")
(setq yesorno t)
  )
)[/PHP]

fsxm

说明第一点与第二点必须s相距0。001以上
[php]
(defun ptlst-gx        (lst / p0 p1 d1 d2 d3 c/2)
  (setq        p0 (car lst)
        p1 (cadr lst)
  )
  (apply 'and
         (mapcar
           '(lambda (n-lst)
              (setq d1        (distance p0 n-lst)
                    d2        (distance p1 n-lst)
                    d3        (distance p0 p1)
                    c/2        (/ (+ d1 d2 d3) 2)
              )
              (equal (* (- c/2 d1) (- c/2 d2) (- c/2 d3)) 0 0.0001)
            )
           (cddr lst)
         )
  )
)
[/php]

测试：
[php]
                                        ;2d点
(ptlst-gx
  (list '(0.0 0.0) '(1.0 1.0) '(2.0 2.0))
)
                                        ;2d+3d点
(ptlst-gx
  (list '(0.0 0.0 0.0) '(1.0 1.0 0.0) '(2.0 2.0))
)
                                        ;3d点
(ptlst-gx
  (list '(0.0 0.0 0.0) '(1.0 1.0 1.0) '(2.0 2.0 2.0))
)
[/php]

jx2008

我的看法：

对于多段线中有弧度组成部分的情况，虽然各节点都在一条直线上，但是多段线整体并不在一条直线上。所以上面各程序只能用于判断点表是否共线，并不能判别多段线在一条直线上。若要判别多段线是否在一条直线上，唯有用面积是否为零来判别。

zhuzi0117

对于多段线中有弧度组成部分的情况，虽然各节点都在一条直线上，但是多段线整体并不在一条直线上。所以上面各程序只能用于判断点表是否共线，并不能判别多段线在一条直线上。若要判别多段线是否在一条直线上，唯有用面积是否为零来判别。

434939575

谢谢分享，

sicky111

不错的函数！