connected polylines corners

Hello

Please help!

I can not lisp.

Seeking a way with a lisp to connect the corners of a closed polyline.

These polylines are always so similar to the example.

There are very many such lines and it would be great if you could solve with a lisp.

Thank you!

Martin

Hi Martin

Try this, but be aware that it will fail if there are duplicate points or if any partial distance is shorter that the "offset" distance.

(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)
 )

Hello Stefan!

That's awesome !!

Many thanks.

It works wonderfully!

Thank you!

Martin

Just in case you would like an alternative which does not use lisp, draw a polyline at the centre, give it a width, and turn Fill off. The effect is the same

Hi Eldon

My polylines exist already.

Only the corner joints are still missing.

thank you

Martin

You're welcome Martin

Duplicate points bug removed

(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)
 )

Hello Stefan!

Many thanks.

Thank you!

Martin

Hello Stefan,

One small thing is I have noticed.

There are drawn all the oblique connections.

But also a connection to the straight end of the polyline.

Would it still possible that you will not use it to create any line on the other is?

That would be great!

Many thanks!

Martin

sorry for my bad English

Updated previous post.

I'm not sure I have covered all the possibilities, I will check again later.

Many thanks!

Nice solution Stefan

Here's another way:

(defun c:test ( / a d e f i l n v x )
   (if (setq e (ssget "_+.:E:S" '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1))))
       (progn
           (setq l (entget (ssname e 0))
                 l (cons (assoc 10 (reverse l)) l)
                 f (lambda ( x ) (reverse (cdr x)))
                 d 1e308 n 0
           )
           (while (setq a (assoc 10 l))
               (and v (< (setq x (distance (cdr a) (car v))) d) (setq d x i n))
               (or (and v (equal (car v) (cdr a) 1e-3))
                   (setq v (cons (cdr a) v))
               )
               (setq l (cdr (member a l))
                     n (1+ n)
               )
           )
           (setq v (f v))
           (repeat i (setq v (reverse (cons (car v) (f v)))))
           (repeat (- (/ (length v) 2) 2)
               (entmake (list '(0 . "LINE") (cons 10 (car (setq v (f (f v))))) (cons 11 (last v))))
           )
       )
   )
   (princ)
)

Thank Mr. Lee Mac!

It works beautifully.

Thanks Martin

Thanks Lee

Your solution is nice and concise, as always.

Maybe Martin is pleased with both lisps and he might have a clean drawing, but we both fail to cover all the exceptions.

Try this polyline:

(entmakex 
'(
   (0 . "LWPOLYLINE")
   (100 . "AcDbEntity")
   (100 . "AcDbPolyline")
   (62 . 3)
   (90 . 12) (70 . 1)
   (10 5.0 5.0) (10 5.0 1.0)
   (10 2.0 1.0) (10 2.0 2.0)
   (10 2.0 2.0) (10 4.0 2.0)
   (10 4.0 4.0) (10 1.0 4.0)
   (10 1.0 0.0) (10 0.0 0.0)
   (10 0.0 5.0) (10 0.0 5.0)
 )
)

Hello Stefan

Oh yes

Your solution is nice and concise, as always.

Thank you!

Maybe Martin is pleased with both lisps and he might have a clean drawing, but we both fail to cover all the exceptions.

Try this polyline:

Good catch - fixed:

([color=BLUE]defun[/color] c:test ( [color=BLUE]/[/color] a d e f i l n v x )
   ([color=BLUE]if[/color] ([color=BLUE]setq[/color] e ([color=BLUE]ssget[/color] [color=MAROON]"_+.:E:S"[/color] '((0 . [color=MAROON]"LWPOLYLINE"[/color]) (-4 . [color=MAROON]"&="[/color]) (70 . 1))))
       ([color=BLUE]progn[/color]
           ([color=BLUE]setq[/color] l ([color=BLUE]entget[/color] ([color=BLUE]ssname[/color] e 0))
                 l ([color=BLUE]cons[/color] ([color=BLUE]assoc[/color] 10 ([color=BLUE]reverse[/color] l)) l)
                 f ([color=BLUE]lambda[/color] ( x ) ([color=BLUE]reverse[/color] ([color=BLUE]cdr[/color] x)))
                 d 1e308 n 0
           )
           ([color=BLUE]while[/color] ([color=BLUE]setq[/color] a ([color=BLUE]assoc[/color] 10 l))
               ([color=BLUE]cond[/color]
                   (   ([color=BLUE]not[/color] v) ([color=BLUE]setq[/color] v ([color=BLUE]cons[/color] ([color=BLUE]cdr[/color] a) v)))
                   (   ([color=BLUE]equal[/color] ([color=BLUE]car[/color] v) ([color=BLUE]cdr[/color] a) 1e-3))
                   (   ([color=BLUE]<[/color] ([color=BLUE]setq[/color] x ([color=BLUE]distance[/color] ([color=BLUE]cdr[/color] a) ([color=BLUE]car[/color] v))) d) ([color=BLUE]setq[/color] d x i n v ([color=BLUE]cons[/color] ([color=BLUE]cdr[/color] a) v)))
                   (   ([color=BLUE]setq[/color] v ([color=BLUE]cons[/color] ([color=BLUE]cdr[/color] a) v)))
               )
               ([color=BLUE]setq[/color] l ([color=BLUE]cdr[/color] ([color=BLUE]member[/color] a l))
                     n ([color=BLUE]1+[/color] n)
               )
           )
           ([color=BLUE]setq[/color] v (f v))
           ([color=BLUE]repeat[/color] i ([color=BLUE]setq[/color] v ([color=BLUE]reverse[/color] ([color=BLUE]cons[/color] ([color=BLUE]car[/color] v) (f v)))))
           ([color=BLUE]repeat[/color] ([color=BLUE]-[/color] ([color=BLUE]/[/color] ([color=BLUE]length[/color] v) 2) 2)
               ([color=BLUE]entmake[/color] ([color=BLUE]list[/color] '(0 . [color=MAROON]"LINE"[/color]) ([color=BLUE]cons[/color] 10 ([color=BLUE]car[/color] ([color=BLUE]setq[/color] v (f (f v))))) ([color=BLUE]cons[/color] 11 ([color=BLUE]last[/color] v))))
           )
       )
   )
   ([color=BLUE]princ[/color])
)