求助，根据已有多边形画对角线

dalin1985 · 发表于 2012-7-13 20:20:54

(defun c:11 ()
(vl-load-com)
(setq i 0 s nil)
(setq ss (ssget '((0 . "LWPOLYLINE"))))
(if ss (progn
   (repeat (sslength ss)
      (setq ent (entget (ssname ss i)))
      (if (= -1 (vlax-get (vlax-ename->vla-object (ssname ss i)) 'closed))
      (progn
(foreach lst ent
      (if (= 10 (car lst))
      (setq s (append s (list (cdr lst))))
      )
)
         (setq pt 0)
         (while (> (length s) pt)
         (command "LINE" (nth pt s) (nth (if (>= (+ 2 pt) (length s))(- (+ 2 pt) (length s)) (+ 2 pt)) s) "")
(setq pt (1+ pt))
      )
      (setq s nil)
      )
      (princ "\n所选多线段不闭合.")
      )
      (setq i (1+ i))
)
)
      (princ "\n未选多线段.")
)
(princ)
)

xsso · 发表于 2012-7-14 00:09:24

太好了，继续学习

yoyoho · 发表于 2012-7-14 07:02:45

感谢 dalin1985 分享源码程序!

longer1000 · 发表于 2012-7-15 11:26:15

感谢 dalin1985 分享源码程序!这才是明经的大道

tanle2020 · 发表于 2013-4-5 11:48:59

dalin1985 发表于 2012-7-13 20:20
(defun c:11 ()
(vl-load-com)
(setq i 0 s nil)

对角线会有重叠线，哪位大侠优化一下

dalin1985 · 发表于 2013-4-6 11:51:22

tanle2020 发表于 2013-4-5 11:48
对角线会有重叠线，哪位大侠优化一下

是你的多段线有重复点吧

tanle2020 · 发表于 2013-4-6 15:58:11

dalin1985 发表于 2013-4-6 11:51
是你的多段线有重复点吧

没有啊，我就画一个普通的矩形试的

dalin1985 · 发表于 2013-4-6 18:43:37

tanle2020 发表于 2013-4-6 15:58
没有啊，我就画一个普通的矩形试的

还真是，4个顶点就有问题

dalin1985 · 发表于 2013-4-6 19:33:53

tanle2020 发表于 2013-4-6 15:58
没有啊，我就画一个普通的矩形试的

(defun c:11 ()
(vl-load-com)
(setq i 0 s nil)
(setq ss (ssget '((0 . "LWPOLYLINE"))))
(if ss (progn
      (repeat (sslength ss)
         (setq ent (entget (ssname ss i)))
         (if (= -1 (vlax-get (vlax-ename->vla-object (ssname ss i)) 'closed))
            (progn
            (foreach lst ent
                  (if (= 10 (car lst))
                  (setq s (append s (list (cdr lst))))
                  )
            )
            (setq pt 0)
(setq len (length s))
(if (= len 4) (setq len 2))
            (while (> len pt)
            (command "LINE" (nth pt s) (nth (if (>= (+ 2 pt) (length s))(- (+ 2 pt) (length s)) (+ 2 pt)) s) "")
            (setq pt (1+ pt))
            )
            (setq s nil)
         )
         (princ "\n所选多线段不闭合.")
         )
         (setq i (1+ i))
      )
      )
      (princ "\n未选多线段.")
)
(princ)
)

tanle2020 · 发表于 2013-4-7 08:52:46

dalin1985 发表于 2013-4-6 19:33
(defun c:11 ()
(vl-load-com)
(setq i 0 s nil)

解决，非常完美，

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