[LISP程序]：请教判断闭合PLINE点的两个算法问题

小狼 · 发表于 2004-11-28 09:15:15

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

问题1：

一条闭合PLINE线，怎么能判断出线是以顺时针方向走的？

问题2：

怎样能判断出一条闭合PLINE线的左上角？

以上问题用于测绘地藉图的宗地线

圆位左上角点，箭头位闭合线顺时针方向

lsjjm · 发表于 2004-11-28 09:44:00

1. 一般来说多义线并没有顺时/逆时这种属性, 对于简单的多义线得给出充分的已知条件, 最好贴个图或详细说明一下.
2. 能否用通俗的CAD语言来描绘什么是"PLINE线的左上角" ? 否则非测绘专业的朋友想帮你也爱莫能助.

ll_j · 发表于 2004-11-28 18:00:02

这是小狼的图：

登录/注册后可看大图

两个问题都不严密，不过给定一些条件，倒也可以变通。
1.对于地块，一般可以认为是闭合的，且线形没有扭曲的（“8”字形），可以将各个点坐标平均求一个假定中心，然后根据各点与此点的关系判别顺逆，此种方法对包含凹边的、形状怪异的地块就不行了，这里就当作抛砖引玉吧。
2.所谓左上角，无非就是说“X坐标较小，Y坐标较大”，单单这个条件是不足以判断较复杂图形的，还需要设定另外的条件。

自由的鱼 · 发表于 2004-11-28 18:49:02

关键是做这些有什么意义吗？地籍我也做过，好象不需要判断这些吧？它是根据第一个点来判断序号，后面的顺序正、反都没有特定的要求！

小狼 · 发表于 2004-11-28 21:04:49

地藉点好要以左上角一个点按顺时针方向排序啊

自由的鱼 · 发表于 2004-11-28 21:41:06

你用的是什么做图系统？

lsjjm · 发表于 2004-11-29 05:10:20

试试这个：
判断多义线是否顺时针走向（只适用于单纯走向的多义线）
[php]
(defun c:test (/ pp)
 (setq ent (car (entsel "\nSelect a Polyline:")))
 (setq pp (acet-geom-vertex-list ent))
 (setq ang (angle (car pp)(cadr pp)))
 (if (or (and (>= ang 0)(< ang (/ pi 2)))
 (and (> ang (* 1.5 pi))(<= ang (* 2 pi))))
T
nil
 )
)
[/php]

小狼 · 发表于 2004-12-1 20:29:01

最初由自由的鱼发布
[B]你用的是什么做图系统？ [/B]

我用的MAP6，也就是CAD2002

自由的鱼 · 发表于 2004-12-1 22:45:31

最初由小狼发布
[B]

我用的MAP6，也就是CAD2002 [/B]

你的地籍功能是自己开发的吗？

eachy · 发表于 2004-12-2 00:07:37

摘录 XD 工具箱函数

;|
返回点表的Y最小，X最小
|;
(defun $XDLSP_Points_MinY->MinX (pts / box n disy disx old new ptl)
(setq box (apply
'xdrx_pointsbox
pts
)
)
(foreach n pts
(setq disy (abs (xdrx_p2ldist n (car box) (cadr box)))
disx (abs (xdrx_p2ldist n (car box) (last box)))
disx (atof (rtos disx 2 3))
disy (atof (rtos disy 2 3))
)
(if (setq old (assoc disy ptl))
(progn
(setq new (list disy (cons (list disx n) (cadr old)))
ptl (subst
new
old
ptl
)
)
)
(progn
(setq ptl (cons (list disy (list (list disx n))) ptl))
)
)
)
(cadar (apply
'xdrx_rlistsort2
(cadar (apply
'xdrx_rlistsort2
ptl
)
)
)
)
)
;|
返回点表的Y最小，X最大
|;
(defun $XDLSP_Points_MinY->MaxX (pts / ptl box n disy disx old new ptl)
(setq box (apply
'xdrx_pointsbox
pts
)
)
(foreach n pts
(setq disy (abs (xdrx_p2ldist n (car box) (cadr box)))
disx (abs (xdrx_p2ldist n (car box) (last box)))
disx (atof (rtos disx 2 3))
disy (atof (rtos disy 2 3))
)
(if (setq old (assoc disy ptl))
(progn
(setq new (list disy (cons (list disx n) (cadr old)))
ptl (subst
new
old
ptl
)
)
)
(progn
(setq ptl (cons (list disy (list (list disx n))) ptl))
)
)
)
(cadr (last (apply
'xdrx_rlistsort2
(cadar (apply
'xdrx_rlistsort2
ptl
)
)
)
)
)
)
;|
返回点表的Y最大，X最小
|;
(defun $XDLSP_Points_MaxY->MinX (pts / ptl box n disy disx old new ptl)
(setq box (apply
'xdrx_pointsbox
pts
)
)
(foreach n pts
(setq disy (abs (xdrx_p2ldist n (car box) (cadr box)))
disx (abs (xdrx_p2ldist n (car box) (last box)))
disx (atof (rtos disx 2 3))
disy (atof (rtos disy 2 3))
)
(if (setq old (assoc disy ptl))
(progn
(setq new (list disy (cons (list disx n) (cadr old)))
ptl (subst
new
old
ptl
)
)
)
(progn
(setq ptl (cons (list disy (list (list disx n))) ptl))
)
)
)
(cadar (apply
'xdrx_rlistsort2
(cadr (last (apply
'xdrx_rlistsort2
ptl
)
)
)
)
)
)
;|
返回点表的Y最大，X最大
|;
(defun $XDLSP_Points_MaxY->MaxX (pts / ptl box n disy disx old new ptl)
(setq box (apply
'xdrx_pointsbox
pts
)
)
(foreach n pts
(setq disy (abs (xdrx_p2ldist n (car box) (cadr box)))
disx (abs (xdrx_p2ldist n (car box) (last box)))
disx (atof (rtos disx 2 3))
disy (atof (rtos disy 2 3))
)
(if (setq old (assoc disy ptl))
(progn
(setq new (list disy (cons (list disx n) (cadr old)))
ptl (subst
new
old
ptl
)
)
)
(progn
(setq ptl (cons (list disy (list (list disx n))) ptl))
)
)
)
(cadr (last (apply
'xdrx_rlistsort2
(cadr (last (apply
'xdrx_rlistsort2
ptl
)
)
)
)
)
)
)
;|
返回点表的X最大，Y最小
|;
(defun $XDLSP_Points_MaxX->MinY (pts / ptl box n disy disx old new ptl)
(setq box (apply
'xdrx_pointsbox
pts
)
)
(foreach n pts
(setq disy (abs (xdrx_p2ldist n (car box) (cadr box)))
disx (abs (xdrx_p2ldist n (car box) (last box)))
disx (atof (rtos disx 2 3))
disy (atof (rtos disy 2 3))
)
(if (setq old (assoc disx ptl))
(progn
(setq new (list disx (cons (list disy n) (cadr old)))
ptl (subst
new
old
ptl
)
)
)
(progn
(setq ptl (cons (list disx (list (list disy n))) ptl))
)
)
)
(cadar (apply
'xdrx_rlistsort2
(cadr (last (apply
'xdrx_rlistsort2
ptl
)
)
)
)
)
)
;|
返回点表的X最大，Y最大
|;
(defun $XDLSP_Points_MaxX->MaxY (pts / ptl box n disy disx old new ptl)
(setq box (apply
'xdrx_pointsbox
pts
)
)
(foreach n pts
(setq disy (abs (xdrx_p2ldist n (car box) (cadr box)))
disx (abs (xdrx_p2ldist n (car box) (last box)))
disx (atof (rtos disx 2 3))
disy (atof (rtos disy 2 3))
)
(if (setq old (assoc disx ptl))
(progn
(setq new (list disx (cons (list disy n) (cadr old)))
ptl (subst
new
old
ptl
)
)
)
(progn
(setq ptl (cons (list disx (list (list disy n))) ptl))
)
)
)
(cadr (last (apply
'xdrx_rlistsort2
(cadr (last (apply
'xdrx_rlistsort2
ptl
)
)
)
)
)
)
)
;|
返回点表的X最小，Y最大
|;
(defun $XDLSP_Points_MinX->MaxY (pts / ptl box n disy disx old new ptl)
(setq box (apply
'xdrx_pointsbox
pts
)
)
(foreach n pts
(setq disy (abs (xdrx_p2ldist n (car box) (cadr box)))
disx (abs (xdrx_p2ldist n (car box) (last box)))
disx (atof (rtos disx 2 3))
disy (atof (rtos disy 2 3))
)
(if (setq old (assoc disx ptl))
(progn
(setq new (list disx (cons (list disy n) (cadr old)))
ptl (subst
new
old
ptl
)
)
)
(progn
(setq ptl (cons (list disx (list (list disy n))) ptl))
)
)
)
(cadr (last (apply
'xdrx_rlistsort2
(cadar (apply
'xdrx_rlistsort2
ptl
)
)
)
)
)
)
;|
返回点表的X最小，Y最小
|;
(defun $XDLSP_Points_MinX->MinY (pts / ptl box n disy disx old new ptl)
(setq box (apply
'xdrx_pointsbox
pts
)
)
(foreach n pts
(setq disy (abs (xdrx_p2ldist n (car box) (cadr box)))
disx (abs (xdrx_p2ldist n (car box) (last box)))
disx (atof (rtos disx 2 3))
disy (atof (rtos disy 2 3))
)
(if (setq old (assoc disx ptl))
(progn
(setq new (list disx (cons (list disy n) (cadr old)))
ptl (subst
new
old
ptl
)
)
)
(progn
(setq ptl (cons (list disx (list (list disy n))) ptl))
)
)
)
(cadar (apply
'xdrx_rlistsort2
(cadar (apply
'xdrx_rlistsort2
ptl
)
)
)
)
)

;| 
   返回点表的Y最小，X最小 
|; 
(defun $XDLSP_Points_MinY->MinX        (pts / box n disy disx old new ptl) 
  (setq        box (apply 
              'xdrx_pointsbox 
              pts 
            ) 
  ) 
  (foreach n pts 
    (setq disy (abs (xdrx_p2ldist n (car box) (cadr box))) 
          disx (abs (xdrx_p2ldist n (car box) (last box))) 
          disx (atof (rtos disx 2 3)) 
          disy (atof (rtos disy 2 3)) 
    ) 
    (if        (setq old (assoc disy ptl)) 
      (progn 
        (setq new (list disy (cons (list disx n) (cadr old))) 
              ptl (subst 
                    new 
                    old 
                    ptl 
                  ) 
        ) 
      ) 
      (progn 
        (setq ptl (cons (list disy (list (list disx n))) ptl)) 
      ) 
    ) 
  ) 
  (cadar (apply 
           'xdrx_rlistsort2 
           (cadar (apply 
                    'xdrx_rlistsort2 
                    ptl 
                  ) 
           ) 
         ) 
  ) 
) 
 ;| 
   返回点表的Y最小，X最大 
|; 
(defun $XDLSP_Points_MinY->MaxX        (pts / ptl box n disy disx old new ptl) 
  (setq        box (apply 
              'xdrx_pointsbox 
              pts 
            ) 
  ) 
  (foreach n pts 
    (setq disy (abs (xdrx_p2ldist n (car box) (cadr box))) 
          disx (abs (xdrx_p2ldist n (car box) (last box))) 
          disx (atof (rtos disx 2 3)) 
          disy (atof (rtos disy 2 3)) 
    ) 
    (if        (setq old (assoc disy ptl)) 
      (progn 
        (setq new (list disy (cons (list disx n) (cadr old))) 
              ptl (subst 
                    new 
                    old 
                    ptl 
                  ) 
        ) 
      ) 
      (progn 
        (setq ptl (cons (list disy (list (list disx n))) ptl)) 
      ) 
    ) 
  ) 
  (cadr        (last (apply 
                'xdrx_rlistsort2 
                (cadar (apply 
                         'xdrx_rlistsort2 
                         ptl 
                       ) 
                ) 
              ) 
        ) 
  ) 
) 
 ;| 
   返回点表的Y最大，X最小 
|; 
(defun $XDLSP_Points_MaxY->MinX        (pts / ptl box n disy disx old new ptl) 
  (setq        box (apply 
              'xdrx_pointsbox 
              pts 
            ) 
  ) 
  (foreach n pts 
    (setq disy (abs (xdrx_p2ldist n (car box) (cadr box))) 
          disx (abs (xdrx_p2ldist n (car box) (last box))) 
          disx (atof (rtos disx 2 3)) 
          disy (atof (rtos disy 2 3)) 
    ) 
    (if        (setq old (assoc disy ptl)) 
      (progn 
        (setq new (list disy (cons (list disx n) (cadr old))) 
              ptl (subst 
                    new 
                    old 
                    ptl 
                  ) 
        ) 
      ) 
      (progn 
        (setq ptl (cons (list disy (list (list disx n))) ptl)) 
      ) 
    ) 
  ) 
  (cadar (apply 
           'xdrx_rlistsort2 
           (cadr (last (apply 
                         'xdrx_rlistsort2 
                         ptl 
                       ) 
                 ) 
           ) 
         ) 
  ) 
) 
 ;| 
   返回点表的Y最大，X最大 
|; 
(defun $XDLSP_Points_MaxY->MaxX        (pts / ptl box n disy disx old new ptl) 
  (setq        box (apply 
              'xdrx_pointsbox 
              pts 
            ) 
  ) 
  (foreach n pts 
    (setq disy (abs (xdrx_p2ldist n (car box) (cadr box))) 
          disx (abs (xdrx_p2ldist n (car box) (last box))) 
          disx (atof (rtos disx 2 3)) 
          disy (atof (rtos disy 2 3)) 
    ) 
    (if        (setq old (assoc disy ptl)) 
      (progn 
        (setq new (list disy (cons (list disx n) (cadr old))) 
              ptl (subst 
                    new 
                    old 
                    ptl 
                  ) 
        ) 
      ) 
      (progn 
        (setq ptl (cons (list disy (list (list disx n))) ptl)) 
      ) 
    ) 
  ) 
  (cadr        (last (apply 
                'xdrx_rlistsort2 
                (cadr (last (apply 
                              'xdrx_rlistsort2 
                              ptl 
                            ) 
                      ) 
                ) 
              ) 
        ) 
  ) 
) 
 ;| 
   返回点表的X最大，Y最小 
|; 
(defun $XDLSP_Points_MaxX->MinY        (pts / ptl box n disy disx old new ptl) 
  (setq        box (apply 
              'xdrx_pointsbox 
              pts 
            ) 
  ) 
  (foreach n pts 
    (setq disy (abs (xdrx_p2ldist n (car box) (cadr box))) 
          disx (abs (xdrx_p2ldist n (car box) (last box))) 
          disx (atof (rtos disx 2 3)) 
          disy (atof (rtos disy 2 3)) 
    ) 
    (if        (setq old (assoc disx ptl)) 
      (progn 
        (setq new (list disx (cons (list disy n) (cadr old))) 
              ptl (subst 
                    new 
                    old 
                    ptl 
                  ) 
        ) 
      ) 
      (progn 
        (setq ptl (cons (list disx (list (list disy n))) ptl)) 
      ) 
    ) 
  ) 
  (cadar (apply 
           'xdrx_rlistsort2 
           (cadr (last (apply 
                         'xdrx_rlistsort2 
                         ptl 
                       ) 
                 ) 
           ) 
         ) 
  ) 
) 
 ;| 
   返回点表的X最大，Y最大 
|; 
(defun $XDLSP_Points_MaxX->MaxY        (pts / ptl box n disy disx old new ptl) 
  (setq        box (apply 
              'xdrx_pointsbox 
              pts 
            ) 
  ) 
  (foreach n pts 
    (setq disy (abs (xdrx_p2ldist n (car box) (cadr box))) 
          disx (abs (xdrx_p2ldist n (car box) (last box))) 
          disx (atof (rtos disx 2 3)) 
          disy (atof (rtos disy 2 3)) 
    ) 
    (if        (setq old (assoc disx ptl)) 
      (progn 
        (setq new (list disx (cons (list disy n) (cadr old))) 
              ptl (subst 
                    new 
                    old 
                    ptl 
                  ) 
        ) 
      ) 
      (progn 
        (setq ptl (cons (list disx (list (list disy n))) ptl)) 
      ) 
    ) 
  ) 
  (cadr        (last (apply 
                'xdrx_rlistsort2 
                (cadr (last (apply 
                              'xdrx_rlistsort2 
                              ptl 
                            ) 
                      ) 
                ) 
              ) 
        ) 
  ) 
) 
 ;| 
   返回点表的X最小，Y最大 
|; 
(defun $XDLSP_Points_MinX->MaxY        (pts / ptl box n disy disx old new ptl) 
  (setq        box (apply 
              'xdrx_pointsbox 
              pts 
            ) 
  ) 
  (foreach n pts 
    (setq disy (abs (xdrx_p2ldist n (car box) (cadr box))) 
          disx (abs (xdrx_p2ldist n (car box) (last box))) 
          disx (atof (rtos disx 2 3)) 
          disy (atof (rtos disy 2 3)) 
    ) 
    (if        (setq old (assoc disx ptl)) 
      (progn 
        (setq new (list disx (cons (list disy n) (cadr old))) 
              ptl (subst 
                    new 
                    old 
                    ptl 
                  ) 
        ) 
      ) 
      (progn 
        (setq ptl (cons (list disx (list (list disy n))) ptl)) 
      ) 
    ) 
  ) 
  (cadr        (last (apply 
                'xdrx_rlistsort2 
                (cadar (apply 
                         'xdrx_rlistsort2 
                         ptl 
                       ) 
                ) 
              ) 
        ) 
  ) 
) 
 ;| 
   返回点表的X最小，Y最小 
|; 
(defun $XDLSP_Points_MinX->MinY        (pts / ptl box n disy disx old new ptl) 
  (setq        box (apply 
              'xdrx_pointsbox 
              pts 
            ) 
  ) 
  (foreach n pts 
    (setq disy (abs (xdrx_p2ldist n (car box) (cadr box))) 
          disx (abs (xdrx_p2ldist n (car box) (last box))) 
          disx (atof (rtos disx 2 3)) 
          disy (atof (rtos disy 2 3)) 
    ) 
    (if        (setq old (assoc disx ptl)) 
      (progn 
        (setq new (list disx (cons (list disy n) (cadr old))) 
              ptl (subst 
                    new 
                    old 
                    ptl 
                  ) 
        ) 
      ) 
      (progn 
        (setq ptl (cons (list disx (list (list disy n))) ptl)) 
      ) 
    ) 
  ) 
  (cadar (apply 
           'xdrx_rlistsort2 
           (cadar (apply 
                    'xdrx_rlistsort2 
                    ptl 
                  ) 
           ) 
         ) 
  ) 
)

狂刀 · 发表于 2004-12-2 01:14:20

;; 返回点表 (x最小点 x最大点 y最小点 y最大点)
(defun ttt (pts / ps1 ps2)
(setq ps1 (vl-sort pts '(lambda(x y)(<(car x)(car y))))
ps2 (vl-sort pts '(lambda(x y)(<(cadr x)(cadr y)))))
(list (car ps1)(last ps1)(car ps2)(last ps2))
)
(setq pts '((0. 1.2)(5.1 3.3)(2.5 6.3)(1.2 3.6)(2.3 3.1)(5.0 1.4)(0.2 4.3)(0.9 0.5)))
(ttt pts) ;->((0.0 1.2) (5.1 3.3) (0.9 0.5) (2.5 6.3))
;; 返回点表 (x最小值 x最大值 y最小值 y最大值)
(defun ttt2 (pts /)
(setq lst (ttt pts))
(list (car(nth 0 lst)) (car(nth 1 lst)) (cadr(nth 2 lst)) (cadr(nth 3 lst)))
)
(ttt2 pts);->(0.0 5.1 0.5 6.3)

xxxyzxx · 发表于 2004-12-2 09:48:12

不懂2楼长老的意思，7楼的程序能适合闭合PLINE吗？顺逆时针走向直接关系3D贴图（但现在大家都使运算庞大的实体了）
10楼的斑竹的程序好长，我有些吃不消～～～

lsjjm · 发表于 2004-12-2 11:07:27

最初由 xxxyzxx 发布
[B]不懂2楼长老的意思，7楼的程序能适合闭合PLINE吗？。。。[/B]

7楼的程序可用于闭合或非闭合的多义线。其实，你试一下不就知道了吗？

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

[LISP程序]：请教判断闭合PLINE点的两个算法问题

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子