Topic: Ulimate / Maxium Fillet Of Multiple Segment PLINE or Points

[ribarm]

I'd stick to my previously posted updated code with new (remstenvert) sub-function, but if you have already prepared lwpolyline for all arced segments like your posted gif, I've decided to post my version for that and only that case - otherwise arcs may cross original lwpolyline and that's not desired result...

Code: [Select]

(defun clean_poly ( ent / trunc e_lst p_lst )

  (defun trunc ( expr lst )
    (if (and lst (not (equal (car lst) expr)))
      (cons (car lst) (trunc expr (cdr lst)))
    )
  )

  (setq e_lst (entget ent))
  (if (= "LWPOLYLINE" (cdr (assoc 0 e_lst)))
    (progn
      (setq p_lst
                  (vl-remove-if-not
                   '(lambda (x)
                      (or (= (car x) 10)
                          (= (car x) 40)
                          (= (car x) 41)
                          (= (car x) 42)
                      )
                    )
                    e_lst
                  )
            e_lst
                  (vl-remove-if
                   '(lambda (x)
                      (member x p_lst)
                    )
                    e_lst
                  )
      )
      (if (= 1 (logand (cdr (assoc 70 e_lst)) 1))
        (while (equal (car p_lst) (assoc 10 (reverse p_lst)))
          (setq p_lst (reverse (cdr (member (assoc 10 (reverse p_lst)) (reverse p_lst)))))
        )
      )
      (while p_lst
        (setq e_lst (append e_lst (trunc (assoc 10 (cdr p_lst)) p_lst))
              p_lst (member (assoc 10 (cdr p_lst)) (cdr p_lst))
        )
      )
      (entmod e_lst)
    )
  )
  (princ)
)

(defun maxfillet ( ent / enx lst opn ch p1 p2 )
    (setq enx (entget ent)
          lst (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) enx))
          opn (zerop (logand 1 (cdr (assoc 70 enx))))
    )
    (if opn
        (progn
            (initget "Continuation Segmentation")
            (setq ch  (getkword "\nCalculate arcs from starting arcs continuation or minimal segment distances for open polyline (Continuation/Segmentation) <Continuation> : "))
        )
    )
    (setq lst
        (apply 'append
            (apply 'mapcar
                (cons
                    (function
                        (lambda ( v1 v2 v3 / a1 a2 d1 p3 )
                            (if
                                (and v1 v2 v3
                                    (setq
                                        a1 (angle v2 v1)
                                        a2 (angle v2 v3)
                                        d1 (cond
                                               (   (and opn (equal v1 (car lst) 1e-8))
                                                   (/ (min (* 2 (distance v1 v2)) (distance v2 v3)) 2.0)
                                               )
                                               (   (and opn (equal v3 (last lst) 1e-8))
                                                   (/ (min (distance v1 v2) (* 2 (distance v2 v3))) 2.0)
                                               )
                                               (   (/ (min (distance v1 v2) (distance v2 v3)) 2.0))
                                           )
                                        p1 (if (and opn p2 (or (eq ch nil) (eq ch "Continuation"))) p2 (if (and opn (or (eq ch nil) (eq ch "Continuation")) (< (distance v1 v2) (distance v2 v3))) (polar v2 a1 (distance v1 v2)) (polar v2 a1 d1)))
                                        p2 (if (and opn (or (eq ch nil) (eq ch "Continuation"))) (polar v2 a2 (distance v2 p1)) (polar v2 a2 d1))
                                        p3 (inters p1 (polar p1 (+ a1 (/ pi 2)) 1) p2 (polar p2 (+ a2 (/ pi 2)) 1) nil)
                                    )
                                )
                                (list
                                    (cons 10 p1)
                                    (cons 42 (tan (/ (- pi (abs (- a1 a2))) (if (minusp (- a1 a2)) -4.0 4.0))))
                                    (cons 10 p2)
                                )
                                (list (cons 10 v2))
                            )
                        )
                    )
                    (if opn
                        (list (cons 'nil lst) lst (append (cdr lst) '(nil)))
                        (list (cons (last lst) lst) lst (append (cdr lst) (list (car lst))))
                    )
                )
            )
        )
    )
    (entmakex
        (append
            (list
               '(000 . "LWPOLYLINE")
               '(100 . "AcDbEntity")
               '(100 . "AcDbPolyline")
                (cons  90 (length (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) lst)))
                (assoc 70 (entget ent))
            )
            lst
        )
    )
)

(defun tan ( x )
    (if (not (equal 0.0 (cos x) 1e-10))
        (/ (sin x) (cos x))
    )
)

(defun remstenvert ( ent / entx prexlst memblst sufxlst )
    (if (and
            (eq (cdr (assoc 0 (setq entx (entget ent)))) "LWPOLYLINE")
            (eq (logand (cdr (assoc 70 (entget ent))) 1) 0)
        )
        (cond ( (and  (equal (assoc 10 entx) (assoc 10 (cdr (member (assoc 10 entx) entx))) 1e-3)
                      (equal (assoc 10 (reverse entx)) (assoc 10 (cdr (member (assoc 10 (reverse entx)) (reverse entx)))) 1e-3)
                )
                (progn
                    (setq memblst (member (assoc 10 entx) entx))
                    (setq memblst (member (assoc 10 (cdr memblst)) memblst))
                    (setq memblst (reverse (cdr (member (assoc 10 (reverse memblst)) (reverse memblst)))))
                    (setq prexlst (vl-remove-if '(lambda ( x ) (or (= 10 (car x)) (= 40 (car x)) (= 41 (car x)) (= 42 (car x)) (= 91 (car x)) (= 210 (car x)))) entx))
                    (setq prexlst (subst (cons 90 (length (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) memblst))) (assoc 90 prexlst) prexlst))
                    (setq sufxlst (list (assoc 210 entx)))
                    (entmod (append prexlst memblst sufxlst))
                    (entupd (cdr (assoc -1 entx)))
                )
              )
              ( (and  (equal (assoc 10 entx) (assoc 10 (cdr (member (assoc 10 entx) entx))) 1e-3)
                      (not (equal (assoc 10 (reverse entx)) (assoc 10 (cdr (member (assoc 10 (reverse entx)) (reverse entx)))) 1e-3))
                )
                (progn
                    (setq memblst (member (assoc 10 entx) entx))
                    (setq memblst (member (assoc 10 (cdr memblst)) memblst))
                    (setq prexlst (vl-remove-if '(lambda ( x ) (or (= 10 (car x)) (= 40 (car x)) (= 41 (car x)) (= 42 (car x)) (= 91 (car x)) (= 210 (car x)))) entx))
                    (setq prexlst (subst (cons 90 (length (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) memblst))) (assoc 90 prexlst) prexlst))
                    (setq sufxlst (list (assoc 210 entx)))
                    (entmod (append prexlst memblst sufxlst))
                    (entupd (cdr (assoc -1 entx)))
                )
              )
              ( (and  (not (equal (assoc 10 entx) (assoc 10 (cdr (member (assoc 10 entx) entx))) 1e-3))
                      (equal (assoc 10 (reverse entx)) (assoc 10 (cdr (member (assoc 10 (reverse entx)) (reverse entx)))) 1e-3)
                )
                (progn
                    (setq memblst (member (assoc 10 entx) entx))
                    (setq memblst (reverse (cdr (member (assoc 10 (reverse memblst)) (reverse memblst)))))
                    (setq prexlst (vl-remove-if '(lambda ( x ) (or (= 10 (car x)) (= 40 (car x)) (= 41 (car x)) (= 42 (car x)) (= 91 (car x)) (= 210 (car x)))) entx))
                    (setq prexlst (subst (cons 90 (length (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) memblst))) (assoc 90 prexlst) prexlst))
                    (setq sufxlst (list (assoc 210 entx)))
                    (entmod (append prexlst memblst sufxlst))
                    (entupd (cdr (assoc -1 entx)))
                )
              )
              ( (and  (not (equal (assoc 10 entx) (assoc 10 (cdr (member (assoc 10 entx) entx))) 1e-3))
                      (not (equal (assoc 10 (reverse entx)) (assoc 10 (cdr (member (assoc 10 (reverse entx)) (reverse entx)))) 1e-3))
                )
                (entupd (cdr (assoc -1 entx)))
              )
        )       
    )
)

(defun c:maxpolf ( / ent enx )
    (if (not ent)
        (progn
            (setvar 'errno 0)
            (setq ent (car (entsel "\nSelect polyline: ")))
            (cond
                (   (= 7 (getvar 'errno))
                    (princ "\nMissed, try again.")
                )
                (   (null ent) nil)
                (   (/= "LWPOLYLINE" (cdr (assoc 0 (setq enx (entget ent)))))
                    (princ "\nSelected object is not a polyline.")
                )
                (   (vl-some '(lambda ( x ) (and (= 42 (car x)) (not (equal 0.0 (cdr x) 1e-8)))) enx)
                    (princ "\nSelected polyline has arc segments.")
                )
                (   t
                    (maxfillet ent)
                    (clean_poly (entlast))
                    (remstenvert (entlast))
                )
            )
        )
    )
    (princ)
)

P.S. I hope you're getting better David... Unfortunately there are no superheros like Superman on this kind of world, you have to do thing that you want with your bare hands (if you don't have gloves  )
 

[RAYAKMAL]

Wow Lee Mac..

Thank You..

The problem is your Code is so advance/complex, I can't tweak it for my specific purpose.
In road geometric design, ideally I have to put a straight line between consecutive curve, for example 15 or 25 meter.
The question is, how can I achieve that with your code?
Thanks

[Lee Mac]

Wow Lee Mac..

Thank You..

The problem is your Code is so advance/complex, I can't tweak it for my specific purpose.
In road geometric design, ideally I have to put a straight line between consecutive curve, for example 15 or 25 meter.
The question is, how can I achieve that with your code?
Thanks

Thanks RAYAKMAL 

Try this quick mod:

Code: [Select]

(defun maxfillet ( ent dis / enx lst opn )
    (setq enx (entget ent)
          lst (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) enx))
          opn (zerop (logand 1 (cdr (assoc 70 enx))))
          dis (/ dis 2.0)
    )
    (setq lst
        (apply 'append
            (apply 'mapcar
                (cons
                    (function
                        (lambda ( v1 v2 v3 / a1 a2 d1 p1 p2 p3 )
                            (if
                                (and v1 v2 v3
                                    (setq
                                        a1 (angle v2 v1)
                                        a2 (angle v2 v3)
                                        d1 (cond
                                               (   (and opn (equal v1 (car lst) 1e-8))
                                                   (/ (min (* 2 (distance v1 v2)) (distance v2 v3)) 2.0)
                                               )
                                               (   (and opn (equal v3 (last lst) 1e-8))
                                                   (/ (min (distance v1 v2) (* 2 (distance v2 v3))) 2.0)
                                               )
                                               (   (/ (min (distance v1 v2) (distance v2 v3)) 2.0))
                                           )
                                        d1 (if (< dis d1) (- d1 dis) d1)
                                        p1 (polar v2 a1 d1)
                                        p2 (polar v2 a2 d1)
                                        p3 (inters p1 (polar p1 (+ a1 (/ pi 2)) 1) p2 (polar p2 (+ a2 (/ pi 2)) 1) nil)
                                    )
                                )
                                (list
                                    (cons 10 p1)
                                    (cons 42 (tan (/ (- pi (abs (- a1 a2))) (if (minusp (- a1 a2)) -4.0 4.0))))
                                    (cons 10 p2)
                                )
                                (list (cons 10 v2))
                            )
                        )
                    )
                    (if opn
                        (list (cons 'nil lst) lst (append (cdr lst) '(nil)))
                        (list (cons (last lst) lst) lst (append (cdr lst) (list (car lst))))
                    )
                )
            )
        )
    )
    (entmakex
        (append
            (list
               '(000 . "LWPOLYLINE")
               '(100 . "AcDbEntity")
               '(100 . "AcDbPolyline")
                (cons  90 (length (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) lst)))
                (assoc 70 (entget ent))
            )
            lst
        )
    )
)

;; Tangent  -  Lee Mac
;; Args: x - real

(defun tan ( x )
    (if (not (equal 0.0 (cos x) 1e-10))
        (/ (sin x) (cos x))
    )
)
Test program:

Code: [Select]

(defun c:test ( / dis ent enx )
    (initget 4)
    (setq dis (cond ((getdist "\nSpecify fixed straight length <0.0>: ")) (0.0)))
   
    (while
        (progn
            (setvar 'errno 0)
            (setq ent (car (entsel "\nSelect polyline: ")))
            (cond
                (   (= 7 (getvar 'errno))
                    (princ "\nMissed, try again.")
                )
                (   (null ent) nil)
                (   (/= "LWPOLYLINE" (cdr (assoc 0 (setq enx (entget ent)))))
                    (princ "\nSelected object is not a polyline.")
                )
                (   (vl-some '(lambda ( x ) (and (= 42 (car x)) (not (equal 0.0 (cdr x) 1e-8)))) enx)
                    (princ "\nSelected polyline has arc segments.")
                )
                (   (maxfillet ent dis))
            )
        )
    )
    (princ)
)

[pedroantonio]

Hi , Is it possible to give same parameters manually. Look the attach

Thanks

[RAYAKMAL]

Superb..It works like a charm.
Thank you so much, Lee Mac.

Topo, are You trying to create a spiral-circle-spiral geometry?

[pedroantonio]

hi ,RAYAKMAL i don't know the word in english i think is spiral-circle-spiral geometry. Can anyone help !

Thanks

[Lee Mac]

Superb..It works like a charm.
Thank you so much, Lee Mac.

You're welcome RAYAKMAL 

[pedroantonio]

can any one update the code to spiral-circle-spiral geometry.

Thanks

[David Bethel]

I'm back in the seat somewhat and have started back on this project.

I may have to keep this 1 as a 2000+ only routine as I'm having a difficult time changing these over to a
true vanilla routine where I can pass just coplaner a point to a function  ie (defun maxf (pl) .....)

I can simply convertpoly to light when needed.

Thanks!  -David

PS   I'm going the orthopedic route in lieu of chiroprators

[Lee Mac]

I may have to keep this 1 as a 2000+ only routine as I'm having a difficult time changing these over to a true vanilla routine where I can pass just coplaner a point to a function  ie (defun maxf (pl) .....)

If it helps, here is a Vanilla version of my code from post #9:

Code: [Select]

(defun maxfillet ( ent / enx lst opn )
    (setq enx (entget ent)
          lst (massoc 10 enx)
          opn (zerop (logand 1 (cdr (assoc 70 enx))))
    )
    (setq lst
        (apply 'append
            (apply 'mapcar
                (cons
                    (function
                        (lambda ( v1 v2 v3 / a1 a2 d1 p1 p2 p3 )
                            (if
                                (and v1 v2 v3
                                    (setq
                                        a1 (angle v2 v1)
                                        a2 (angle v2 v3)
                                        d1 (cond
                                               (   (and opn (equal v1 (car lst) 1e-8))
                                                   (/ (min (* 2 (distance v1 v2)) (distance v2 v3)) 2.0)
                                               )
                                               (   (and opn (equal v3 (last lst) 1e-8))
                                                   (/ (min (distance v1 v2) (* 2 (distance v2 v3))) 2.0)
                                               )
                                               (   (/ (min (distance v1 v2) (distance v2 v3)) 2.0))
                                           )
                                        p1 (polar v2 a1 d1)
                                        p2 (polar v2 a2 d1)
                                        p3 (inters p1 (polar p1 (+ a1 (/ pi 2)) 1) p2 (polar p2 (+ a2 (/ pi 2)) 1) nil)
                                    )
                                )
                                (list
                                    (cons 10 p1)
                                    (cons 42 (tan (/ (- pi (abs (- a1 a2))) (if (minusp (- a1 a2)) -4.0 4.0))))
                                    (cons 10 p2)
                                )
                                (list (cons 10 v2))
                            )
                        )
                    )
                    (if opn
                        (list (cons 'nil lst) lst (append (cdr lst) '(nil)))
                        (list (cons (last lst) lst) lst (append (cdr lst) (list (car lst))))
                    )
                )
            )
        )
    )
    (entmakex
        (append
            (list
               '(000 . "LWPOLYLINE")
               '(100 . "AcDbEntity")
               '(100 . "AcDbPolyline")
                (cons  90 (length (massoc 10 lst)))
                (assoc 70 (entget ent))
            )
            lst
        )
    )
)

(defun massoc ( key lst / itm )
    (if (setq itm (assoc key lst))
        (cons (cdr itm) (massoc key (cdr (member itm lst))))
    )
)

;; Tangent  -  Lee Mac
;; Args: x - real

(defun tan ( x )
    (if (not (equal 0.0 (cos x) 1e-10))
        (/ (sin x) (cos x))
    )
)
Or were you looking for the program to generate 2D (heavy) polylines?

[David Bethel]

Thanks Lee.  I'll give it a go !  -David

[Lee Mac]

Thanks Lee.  I'll give it a go !  -David

You're welcome David 

As an extension, here is quickly written Vanilla version which compartmentalises each step of the process and should be compatible with both 2D (Heavy) Polylines & LWPolylines.

Code: [Select]

(defun c:test ( / ent enx )
    (while
        (progn
            (setvar 'errno 0)
            (setq ent (car (entsel "\nSelect polyline: ")))
            (cond
                (   (= 7 (getvar 'errno))
                    (princ "\nMissed, try again.")
                )
                (   (null ent) nil)
                (   (not
                        (and
                            (setq enx (entget ent))
                            (wcmatch (cdr (assoc 0 enx)) "*POLYLINE")
                            (< (cdr (assoc 70 enx)) 2)
                        )
                    )
                    (princ "\nSelected object is not a 2D polyline.")
                )
                (   (arcsegs-p ent)
                    (princ "\nSelected polyline has arc segments.")
                )
                (   (createpoly ent (maxfillet (getvertices ent) (zerop (logand 1 (cdr (assoc 70 enx)))))))
            )
        )
    )
    (princ)
)

(defun arcsegs-p ( ent / arg enx fun )
    (if (= "LWPOLYLINE" (cdr (assoc 0 (setq enx (entget ent)))))
        (setq arg enx
              fun
            (lambda ( lst / itm )
                (and (setq itm (assoc 42 lst))
                     (or (not (equal 0.0 (cdr itm) 1e-8))
                         (fun (cdr (member itm lst)))
                     )
                )
            )
        )
        (setq arg (entnext ent)
              fun
            (lambda ( ent / enx )
                (and (= "VERTEX" (cdr (assoc 0 (setq enx (entget ent)))))
                     (or (not (equal 0.0 (cdr (assoc 42 enx)) 1e-8))
                         (fun (entnext ent))
                     )
                )
            )
        )
    )
    (fun arg)
)           

(defun createpoly ( ent lst / enx )
    (if (= "LWPOLYLINE" (cdr (assoc 0 (setq enx (entget ent)))))
        (entmakex
            (append
                (list
                   '(000 . "LWPOLYLINE")
                   '(100 . "AcDbEntity")
                   '(100 . "AcDbPolyline")
                    (cons  90 (countif (lambda ( x ) (= 10 (car x))) lst))
                    (assoc 70 enx)
                )
                lst
            )
        )
        (progn
            (entmake
                (list
                   '(000 . "POLYLINE")
                    (assoc 70 enx)
                )
            )
            (while (cadr lst)
                (entmake
                    (list
                       '(000 . "VERTEX")
                       '(070 . 0)
                        (car  lst)
                        (cadr lst)
                    )
                )
                (setq lst (cddr lst))
            )
            (if (setq ent (entmakex '((0 . "SEQEND"))))
                (cdr (assoc -2 (entget ent)))
            )
        )
    )
)

(defun countif ( prd lst )
    (apply '+ (mapcar '(lambda ( x ) (if (prd x) 1 0)) lst))
)

(defun getvertices ( ent / enx itm rtn )
    (if (= "LWPOLYLINE" (cdr (assoc 0 (setq enx (entget ent)))))
        (while (setq itm (assoc 10 enx))
            (setq rtn (cons (cdr itm) rtn)
                  enx (cdr (member itm enx))
            )
        )
        (while (= "VERTEX" (cdr (assoc 0 (setq enx (entget (setq ent (entnext ent)))))))
            (setq rtn (cons (cdr (assoc 10 enx)) rtn))
        )
    )
    (reverse rtn)
)   

(defun maxfillet ( lst opn )
    (apply 'append
        (apply 'mapcar
            (cons
                (function
                    (lambda ( v1 v2 v3 / a1 a2 a3 d1 p1 p2 p3 )
                        (if
                            (and v1 v2 v3
                                (setq
                                    a1 (angle v2 v1)
                                    a2 (angle v2 v3)
                                    a3 (/ (- pi (abs (- a1 a2))) (if (minusp (- a1 a2)) -4.0 4.0))
                                    d1 (cond
                                           (   (and opn (equal v1 (car lst) 1e-8))
                                               (/ (min (* 2 (distance v1 v2)) (distance v2 v3)) 2.0)
                                           )
                                           (   (and opn (equal v3 (last lst) 1e-8))
                                               (/ (min (distance v1 v2) (* 2 (distance v2 v3))) 2.0)
                                           )
                                           (   (/ (min (distance v1 v2) (distance v2 v3)) 2.0))
                                       )
                                    p1 (polar v2 a1 d1)
                                    p2 (polar v2 a2 d1)
                                    p3 (inters p1 (polar p1 (+ a1 (/ pi 2)) 1) p2 (polar p2 (+ a2 (/ pi 2)) 1) nil)
                                )
                            )
                            (list
                                (cons 10 p1)
                                (cons 42 (/ (sin a3) (cos a3)))
                                (cons 10 p2)
                               '(42 . 0.0)
                            )
                            (list
                                (cons 10 v2)
                               '(42 . 0.0)
                            )
                        )
                    )
                )
                (if opn
                    (list (cons 'nil lst) lst (append (cdr lst) '(nil)))
                    (list (cons (last lst) lst) lst (append (cdr lst) (list (car lst))))
                )
            )
        )
    )
)

(princ)

[David Bethel]

So that my simple mind can comprehend :

Code: [Select]

;;;FROM LEE MAC The Swamp - Thread 46956.0
;;;ARG -> PointList OPeN-flag
(defun maxfillet ( lst opn )
 (apply 'append
   (apply 'mapcar
     (cons '(lambda ( v1 v2 v3 / a1 a2 a3 d1 p1 p2 p3 )
               (if (and v1 v2 v3
                     (setq a1 (angle v2 v1)
                           a2 (angle v2 v3)
                           a3 (/ (- pi (abs (- a1 a2))) (if (minusp (- a1 a2)) -4.0 4.0))
                           d1 (cond ((and opn (equal v1 (car lst) 1e-8))
                                     (/ (min (* 2 (distance v1 v2)) (distance v2 v3)) 2.0))
                                    ((and opn (equal v3 (last lst) 1e-8))
                                     (/ (min (distance v1 v2) (* 2 (distance v2 v3))) 2.0))
                                    ((/ (min (distance v1 v2) (distance v2 v3)) 2.0))                                                                     )
                           p1 (polar v2 a1 d1)
                           p2 (polar v2 a2 d1)
                           p3 (inters p1 (polar p1 (+ a1 (/ pi 2)) 1) p2 (polar p2 (+ a2 (/ pi 2)) 1) nil)))
                   (list (cons 10 p1)
                         (cons 42 (/ (sin a3) (cos a3)))
                         (cons 10 p2)
                        '(42 . 0.0))
                   (list (cons 10 v2)
                        '(42 . 0.0))))
            (if opn (list (cons 'nil lst) lst (append (cdr lst) '(nil)))
                    (list (cons (last lst) lst) lst (append (cdr lst) (list (car lst)))))))))



Code: [Select]

(defun c:test (/ sp il np pl vl)

  (initget 1)
  (setq sp (getpoint "\nStart Point:  "))
  (setq il (list sp))

  (while (setq np (getpoint sp "\nNext Point (Min 3 Pt Total):   "))
         (grdraw sp np 2 1)
         (setq il (cons np il)
               sp np))
  (if (< (length il) 3)
      (alert "3 Points Min")
      (progn
         (command "_.PLINE")
         (apply 'command il)
         (command "")

         (setq pl (maxfillet il (not (equal (car il) (last il) 1e-8))))

         (entmake (list (cons 0 "POLYLINE")
                        (cons 10 (list 0 0 0))
                        (cons 66 1)
                        (cons 70 0)
                        (cons 210 (trans '(0 0 1) 1 0))))
         (setq vl pl)
         (while vl
           (entmake (list (cons 0 "VERTEX")
                          (car vl)
                          (cadr vl)))
           (setq vl (cddr vl)))

         (entmake (list (cons 0 "SEQEND")
                        (cons 8 "0")))))
  (prin1))

Thank you all for the much needed help.  -David

[David Bethel]

A real world application ;

This is a typical contoured seat booth assembly.

The bench on the left was made from an ultimate fillet path,  The one on the right from a splined polyline path.

There may be 40 to 50 of these booths in a dining room

The file size is much smaller.  The processing time much quicker.  The rendered image from a distance is not noticeably different.

I have quite a few more scenarios where this will be very useful.  ie flex conduits, flex ductwork, any type of of center line path extrusions.

Thanks again.  -David

[Lee Mac]

You're most welcome David - its about time I repayed you for all the help you gave me when I was still learning 

I'm delighted that you can make use of the code, and its fantastic to see the code applied to a real-world application - most of the time, I never see the end result... like an airfix model, when the code is written, the fun is over 

PS. 'Lee Mac' (preferably) or 'Lee McDonnell', but please not 'Lee MacDonald'