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 static/image/common/back.gif
(defun c:11 ()
(vl-load-com)
(setq i 0 s nil)


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

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

tanle2020 发表于 2013-4-5 11:48 static/image/common/back.gif
对角线会有重叠线，哪位大侠优化一下

是你的多段线有重复点吧

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

dalin1985 发表于 2013-4-6 11:51 static/image/common/back.gif
是你的多段线有重复点吧

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

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

tanle2020 发表于 2013-4-6 15:58 static/image/common/back.gif
没有啊，我就画一个普通的矩形试的

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

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

tanle2020 发表于 2013-4-6 15:58 static/image/common/back.gif
没有啊，我就画一个普通的矩形试的

(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 static/image/common/back.gif
(defun c:11 ()
(vl-load-com)
(setq i 0 s nil)


解决，非常完美，
页: 1 [2] 3
查看完整版本: 求助，根据已有多边形画对角线