连接的多段线角点

martinle · 发表于 2022-7-5 18:01:48

你好
请帮忙！
我不会Lisp程序。
使用lisp寻找连接闭合多段线角点的方法。
这些多段线总是与示例非常相似。
有很多这样的行，如果你能用lisp来求解，那就太好了。
非常感谢。
马丁

Stefan BMR · 发表于 2022-7-5 18:07:01

嗨，Martin

尝试此操作，但请注意，如果存在重复点或任何部分距离短于“偏移”距离，则此操作将失败。

(defun connect (e / _point d d1 l p1 p2 a b n i)
 (setq _point vlax-curve-getpointatparam
       d (vlax-curve-getdistatparam e (setq n (fix (+ 0.1 (vlax-curve-getendparam e))))))
 (repeat (setq i (1+ n))
   (setq l (cons (setq p1 (_point e (setq i (1- i)))) l))
   (if
     (setq p2 (cadr l))
     (if
       (and
         (< (setq d1 (distance p1 p2)) d)
         (not (zerop d1))
       )
       (setq
         d d1
         a (rem (1+ i) n)
         b i
         )
       )
     )
   )
 (mapcar 'set '(a b) (list (max a b) (min a b)))
 (while
   (progn
     (setq a (rem (1+ a) n))
     (setq b (rem (+ n (1- b)) n))
     (not (= (rem (1+ a) n) b))
   )
   (entmake
     (list
       '(0 . "LINE")
       (cons 10 (_point e a))
       (cons 11 (_point e b))
       )
     )
   )
 )
(defun c:test (/ ss i)
 (if
   (setq ss (ssget '((0 . "LWPOLYLINE"))))
   (repeat (setq i (sslength ss))
     (connect (ssname ss (setq i (1- i))))
     )
   )
 (princ)
 )

martinle · 发表于 2022-7-5 18:12:36

你好，斯特凡！

太棒了！！
非常感谢。
它工作得很好！

非常感谢。
马丁

eldon · 发表于 2022-7-5 18:16:36

如果您想要一个不使用lisp的替代方案，请在中心绘制一条多段线，给它一个宽度，然后禁用“填充”。效果是一样的

martinle · 发表于 2022-7-5 18:20:34

Hi Eldon公司

我的多段线已经存在。
只有角关节仍然缺失。

非常感谢。

马丁

Stefan BMR · 发表于 2022-7-5 18:24:00

不客气，马丁

删除重复点错误

copy

(defun connect (e / _point d d1 p1 p2 p11 p12 p21 p22 a b n i)
 (setq _point vlax-curve-getpointatparam
       d (vlax-curve-getdistatparam e
           (setq n (fix (+ 0.1 (vlax-curve-getendparam e))))
         )
       )
 (repeat (setq i (1+ n))
   (setq p1 (_point e (setq i (1- i))))
   (if p2
     (if
       (and
         (< (setq d1 (distance p1 p2)) d)
         (not (zerop d1))
       )
       (setq
         d d1
         a (rem (1+ i) n)
         b i
         )
       )
     )
   (setq p2 p1)
   )
 (if (zerop b) (mapcar 'set '(a b) (list b a)))
 (setq p11 (_point e a)
       p21 (_point e b)
       )
 (while
   (progn
     (while
       (equal p11 (setq p12 (_point e (setq a (rem (1+ a) n)))) 1e-
       )
     (while
       (equal p21 (setq p22 (_point e (setq b (rem (+ n (1- b)) n)))) 1e-
       )
     (not
       (or
         (= (abs (- a b)) 1)
         (= (abs (- a b)) n)
       )
     )
   )
   (entmake
     (list
       '(0 . "LINE")
       (cons 10 (setq p11 p12))
       (cons 11 (setq p21 p22))
       )
     )
   )
 )
(defun c:test (/ ss i)
 (if
   (setq ss (ssget '((0 . "LWPOLYLINE"))))
   (repeat (setq i (sslength ss))
     (connect (ssname ss (setq i (1- i))))
     )
   )
 (princ)
 )