多边形顶点重新排序

nzl1116 · 发表于 2013-4-12 20:57:37

第一步，排序
(setq y-Min (car (vl-sort (vl-sort PtLst '(lambda (x y) (< (car x) (car y)))) '(lambda (x y) (< (cadr x) (cadr y))))))
第二步，重排
(setq PtLst (append (member y-Min PtLst) (reversr (cdr (member y-Min (reverse PtLst))))))
第三步，改逆
(if (> (angle y-Min (cadr PtLst)) (angle y-Min (last PtLst)))
(setq PtLst (cons y-Min (reverse (cdr PtLst))))
)

nzl1116 · 发表于 2013-4-12 21:07:43

再提供一个判断多边形的顺逆性和凹凸性的函数

(defun PLC-xPr (PntsLst / PntsLst0 Element PntsLst1 Angle0 Angle1)
(setq PntsLst0 (vl-sort
(vl-sort PntsLst '(lambda (x y) (< (car x) (car y))))
'(lambda (x y) (< (cadr x) (cadr y)))
)
Element (car PntsLst0)
PntsLst0 (append (member Element PntsLst)
(reverse (cdr (member Element (reverse PntsLst))))
)
Angle0 (angle Element (cadr PntsLst0))
Angle1 (angle Element (last PntsLst0))
PntsLst1 (append (cdr PntsLst0) (list Element))
PntsLst0 (mapcar 'angle PntsLst0 PntsLst1)
PntsLst1 (append (cdr PntsLst0) (list (* pi 2.0)))
)
(cond ((vl-every '<= PntsLst0 PntsLst1) 0) ;_ 逆时针凸多边形
((< Angle0 Angle1) 1) ;_ 逆时针凹多边形
((> Angle0 Angle1) 2) ;_ 顺时针多边形
(T -1)
)
)

vlisp2012 · 发表于 2013-4-14 09:57:33

经过几个小时的努力，代码还是很繁琐。
结合了nzl1116和论坛众多高手的代码，没经过大量的测试，请大师们指教

(defun paixu (PtLst )
  (setq y-list  (vl-sort PtLst  '(lambda (x y) (< (cadr x) (cadr y)))));;;good
  (setq y-1 (car y-list)  ;;;y最小值
y-2 (cadr y-list)) ;;;y第二最小值
  (if (< (car y-1) (car y-2))
   (setq x-min y-1)
   (setq x-min y-2));;;取出xy最小值

  (setq PtLst (append (member x-min PtLst) (reverse (cdr (member x-min (reverse PtLst)))))
)
  PtLst )

(defun make_pl(ptab lay )
  (Command "_.layer" "m" lay "")
  (setq wtab(mapcar '(lambda ($pt) (cons 10 $pt)) ptab))
  (setq wtab(append(list '(0 . "LWPOLYLINE")
                     '(100 . "AcDbEntity")
                     '(100 . "AcDbPolyline")
         (cons 8 lay)
                     (cons 90 (length ptab))
         (cons 70 1))
         wtab)
  )
  (entmake wtab)
)
;

(defun c:tt ()
(if (and
   (princ "\n选择封闭多边形 :"))
   (setq ss (ssget '((0 . "LWPOLYLINE"))))
) (progn
(setq n 0)
(repeat (sslength ss)
  (setq en (ssname ss n))
  (setq ent (entget en))
  (if (/= (cdr(assoc 70 ent)) 0) (progn
(setq Pts (list))
(mapcar '(lambda(x) (if (= (car x) 10) (setq Pts (cons (cdr x) Pts)))) ent)
(reverse Pts)
(setq pts (clockwisep Pts))
  (paixu Pts)
(make_pl Pts "6")
  ))
  (setq n (1+ n))
)
))

(defun calo2A (pti ptj)
  (- (* (car pti) (cadr ptj)) (* (car ptj) (cadr pti)))
)

;;; 判断多段线是否为逆时针走向，如逆时针则改为顺时针
(defun clockwisep ( ptlist)
(if (>  (apply '+ (mapcar 'calo2A (cons (last ptlist)(reverse (cdr (reverse ptlist)))) ptlist))
0)
  (setq ptlist (reverse ptlist))
   ptlist

)
  )

vlisp2012 · 发表于 2013-4-14 10:01:54

本来想做成左下角为起始点，结果变成右上角了。请大师们多多指教！

littlx · 发表于 2013-5-24 14:54:51

这个对我很有启发，最近正在写跟这个有关的。

vlisp2012 · 发表于 2013-5-24 19:56:42

littlx 发表于 2013-5-28 09:54
这个对我很有启发，最近正在写跟这个有关的。

其实，Gu版早就解决了这个问题，请参见：
http://bbs.mjtd.com/thread-80267-1-1.html
我也是刚刚看到的。

llsheng_73 · 发表于 2013-10-23 10:12:19

vlisp2012 发表于 2012-5-12 18:57
多谢yjr111。
我还是比较菜，第一个顶点，感觉不好定啊。能提供点代码吗？
原多边形的第一个顶点位置是随 ...

要确定一个多边形顶点的左下角点，需要把顶点的坐标分别按X，Y进行排序，也可以用一个虚拟的正交矩形去框它，与该矩形左下角点最近的点就是该图形的左下角顶点，这个虚拟矩形不需要画出来，你可以直接在顶点的X,Y坐标中分别找出最小值得到该点坐标Ｐ(Xmin，Ymin)，并把具有最小Xmin和Ymin的点都弄出来组成一个新点表(一般情况下只有两个点)，接下来用distance计算Ｐ到新点表中各点的距离找出其中距离最小的那个点就是该图形的左下角点，另外几个方向也可以用类似方法确定

sicky111 · 发表于 2013-10-23 12:48:30

学习一下源码。

xchj81 · 发表于 2014-7-24 21:36:12

学习一下源码。

chshsl · 发表于 2017-8-11 21:57:47

代码很好，但此处有问题，排序没起作用，改下就好了， (paixu Pts)

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