这种线的连接 方法

xdzcp

框选全部上面的白色线条自动生成红色线条，并自动连接。谢谢

pxr201419

(defun c:jj()    (vl-load-com)
    (prompt "选择线条:")
    (setq ss (ssget ":s" '((0 . "*LINE"))) ii 0 ptlst nil ptlst1 nil)
    (while (ssname ss ii)
        (setq en (ssname ss ii)
              pt1 (vlax-curve-getstartpoint en)
              pt2 (vlax-curve-getendpoint en)
              ptlst (append ptlst (list pt1 pt2))
              ii (1+ ii)))
    (setq e1 (entsel "选择第1根线的起始端：")
          p1 (cadr e1)
          e1 (car e1)
          p01 (vlax-curve-getstartpoint e1)
          p02 (vlax-curve-getendpoint e1)
          s1 (distance p1 p01)
          s2 (distance p1 p02))
    (if (> s1 s2)(setq p2 p02)(setq p2 p01))
    (while ptlst
        (setq slst (mapcar '(lambda (x) (distance p2 x)) ptlst))
        (setq n1 (car (vl-sort-i slst '<))
              n2 (fix (/ n1 2)))
        (setq p1 (nth n1 ptlst))
        (if (= n1 (* n2 2))
            (setq p2 (nth (1+ n1) ptlst))
            (setq p2 (nth (1- n1) ptlst))        )
        (setq ptlst (vl-remove p1 ptlst)
              ptlst (vl-remove p2 ptlst))
        (setq ptlst1 (append ptlst1 (list p1) (list p2)))
    )
    (entmake (append (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity")'(100 . "AcDbPolyline")(cons 90 (length ptlst1)))
                     (mapcar '(lambda (x)(cons 10 (reverse(cdr(reverse x))))) ptlst1))
    )
    (setq ii 0)
    (while (ssname ss ii)(entdel (ssname ss ii))(setq ii (1+ ii)))
    )

xdzcp

pxr201419 发表于 2019-8-27 08:20
(defun c:jj()    (vl-load-com)
    (prompt "选择线条:")
    (setq ss (ssget ":s" '((0 . "*LINE"))) ...

谢谢大神 解决了每次都要连接连接 再连接

lsthz

太强大了！
来自: 微社区