[编程申请]：求助!如何对封闭的PL线顶点自动逆时针编号?

cqsnowfox

求助!如何对封闭的PL线顶点自动逆时针编号?要求程序能自动判断起点,起点1号点必须为西北角方向?最好能提供VBA程序,或者提供算法思路!!!1
谢谢!!!!!!

lewyee

我有一个，试试

cqsnowfox

2楼楼主，下载不了，可以讲下思路吗？

xyp1964

“西北角方向”无法确定！

ttthhh_hb

[PHP]

;;;判断多段线是否逆时针
(defun GetCen (pl / pt1 pt2)
  (vla-getboundingbox (vlax-ename->vla-object pl) 'pt1 'pt2)
  (setq pt1 (vlax-safearray->list pt1))
  (setq pt2 (vlax-safearray->list pt2))
  (list        (/ (+ (car pt1) (car pt2)) 2.0)
        (/ (+ (cadr pt1) (cadr pt2)) 2.0)
  )
)
(defun GEO_CCW (p0 p1 p2 p3 / ang1 ang2 ang3)
  (setq ang1 (angle p0 p1))
  (setq ang2 (angle p0 p2))
  (setq ang1 (- ang2 ang1))
  (if (> (abs ang1) pi)
    (setq ang1 (+ (* -2 pi (/ ang1 (abs ang1))) ang1))
  )
  (setq ang3 (angle p0 p3))
  (setq ang2 (- ang3 ang2))
  (if (> (abs ang2) pi)
    (setq ang2 (+ (* -2 pi (/ ang2 (abs ang2))) ang2))
  )
  (if (> (* ang1 ang2) 0)
    (/ ang1 (abs ang1))
    (cond
      ((> (abs ang1) (abs ang2))
       (if (= ang2 0)
         0
         (/ ang2 (abs ang2))
       )
      )
      ((<= (abs ang1) (abs ang2))
       (if (= ang1 0)
         0
         (/ ang1 (abs ang1))
       )
      )
    )
  )
)
(defun PlineCCW        (dpline        / pline        step param nParam pt pt1 pt2 ptc i mp
                 CCWLST)
  (setq pline (car dpline))
  (setq step 100)
  (setq        mp (vla-get-modelspace
             (vla-get-activedocument (vlax-get-acad-object))
           )
  )
  (setq ptc (getcen pline))
  (setq        param (/ (vlax-curve-getDistAtParam
                   pline
                   (vlax-curve-getEndParam pline)
                 )
                 step
              )
  )
  (setq i 0)
  (repeat (1- step)
    (setq nParam (* i param))
    (setq pt (vlax-curve-getPointAtdist pline nParam))
    (setq pt1 (vlax-curve-getPointAtdist
                pline
                (+ (* (/ 0.5 step) param) nParam)
              )
    )
    (setq pt2 (vlax-curve-getPointAtdist
                pline
                (+ (* (/ 1.0 step) param) nParam)
              )
    )
    (setq CCWLST (append CCWLST (list (GEO_CCW ptc pt pt1 pt2))))
    (setq i (1+ i))
  )
  (if (> (length (vl-remove 1.0 CCWLST))
         (length (vl-remove -1.0 CCWLST))
      )
    "F"
    "T"
  )
)                                        ;end defun


;;;返回多段线的各顶点
(defun vertexs (ename / obj plist pp n)
  (setq obj (vlax-ename->vla-object (car ename)))
  (setq        plist (vlax-safearray->list
                (vlax-variant-value
                  (vla-get-coordinates obj)
                )
              )
  )
  (setq n 0)
  (setq pp (list))
  (repeat (/ (length plist) 2)
    (setq pp (append pp (list (list (nth n plist) (nth (1+ n) plist)))))
    (setq n (+ n 2))
  )
  pp
)

;;;;未加容错语句，请自己加
(defun c:test (/ pline plist j k len point sty ht)
  (princ "\n请选择多义线:")
  (setq pline (entsel))
  (PRINC "\n 设置字高:")
  (SETQ ht (getdist))
  (setq sty (getvar "textstyle"))
  (setq plist (vertexs pline))
  (if (= (PlineCCW pline) "F")
    (setq plist (reverse plist))
  )
  (progn
    (setq plist (vertexs pline))
    (if        (= (PlineCCW pline) "F")
      (setq plist (reverse plist))
    )
    (setq j (length plist) len 0 k 0)
    (while (< k j)
      (setq point (car plist))
      (setq plist (cdr plist))
      (setq len (1+ len))
      (entmake
        (list (cons 0 "text")
              (cons 10 point)
              (cons 11 point)
              (cons 7 sty)
              (cons 40 ht)
              (cons 1 (itoa len))
              (cons 72 1)
              (cons 41 0.8)
              (cons 62 2)
        )
      )  
      (setq k (1+ k))
    )
  )
)
[/PHP]

cqsnowfox

我不会lisp啊，我只会vba,可以讲讲算法吗？

xyp1964

参考：http://p4.xdcad.net/forum/showthread.php?s=&threadid=499692

yshf

;;;封闭多边形顶点排序 by yshf
;;;测试程序
;;;将下载的文件“dbxddpx.fas”
;;;存到“L”盘中，如存入其它地方，
;;;请更改程序中第二行中的相应路径名。
;;;用于地藉测量中对宗地界址点编号和排序。

(defun c:cc()
   (if (null dbxddpx)(load "L:dbxddpx.fas"));请注意文件“dbxddpx.fas”存盘路径名
   (setq xtblm '("cmdecho" "osmode")
         xtblz (mapcar 'getvar xtblm)
   )
   (mapcar 'setvar xtblm '(0 0))
   (command "_undo" "be")
   (while (setq en (sel "请选择封闭多段线(LWPOLYLINE/POLYLINE)(按Esc键退出程序)"
                        "LWPOLYLINE,POLYLINE"
                )
          )
      (initget 1 "1 2 3 4")
      (setq pjd (getkword "西北角(1)/西南角(2)/东南角/(3)东北角(4):"))
      (initget 1 "1 2")
      (setq snj (getkword "顺时针(1)/逆时针(2):"))
      ;返回按要求排好序的顶点列表，并赋值给fhb
      (setq fhb (dbxddpx (car en) (read pjd) (read snj))
     i 1
      )
      (foreach pt0 fhb
        (command "_circle" pt0 1 "_chprop" (entlast) "" "c" 1 ""
        "_text" (mapcar '+ pt0 '(0.7 0.7)) 2.5 0 (itoa i)
        "_chprop" (entlast) "" "c" 3 ""
        )
        (setq i (1+ i))
     )
   )
   (command "_undo" "e")
   (mapcar 'setvar xtblm xtblz)(princ)        
)