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 static/image/common/back.gif
这个对我很有启发,最近正在写跟这个有关的。

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

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

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

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

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

学习一下源码。

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

学习一下源码。

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

代码很好,但此处有问题,排序没起作用,改下就好了, (paixu Pts)
页: 1 [2] 3
查看完整版本: 多边形顶点重新排序