I need a lisp to change closed polylines to circles

June 25, 2012

Hi to all,

I have many drawings that need to convert closed polylines to circles with a diameter = 0.20

Could anyone help me with this?

Thanks in advance

June 25, 2012

Try this ...

(defun c:Test (/ ss i sn pt)
 (if (setq ss (ssget "_:L" '((0 . "*POLYLINE") (-4 . "&") (70 . 1))))
   (repeat (setq i (sslength ss))
     (setq sn (ssname ss (setq i (1- i))))
     (vl-remove-if-not
       '(lambda (x)
          (if (eq (car x) 10)
            (setq pt (cons (list (cadr x) (caddr x)) pt))
          )
        )
       (entget sn)
     )
     (entmakex (list '(0 . "CIRCLE")
                     (cons 10
                           (mapcar '(lambda (p q) (/ (+ p q) 2.))
                                   (nth 0 pt)
                                   (nth 2 pt)
                           )
                     )
                     '(40 . 0.2)
               )
     )
     (entdel (cdr (assoc -1 (entget sn))))
   )
 )
 (princ)
)

June 25, 2012

Quick 'n dirty, using the average of the polyline vertices as the circle centre:

([color=BLUE]defun[/color] c:p2c ( [color=BLUE]/[/color] _massoc _pointaverage e i r s )

   ([color=BLUE]setq[/color] r 0.1) [color=GREEN];; Circle Radius[/color]

   ([color=BLUE]defun[/color] _massoc ( k l [color=BLUE]/[/color] p )
       ([color=BLUE]if[/color] ([color=BLUE]setq[/color] p ([color=BLUE]assoc[/color] k l))
           ([color=BLUE]cons[/color] ([color=BLUE]cdr[/color] p) (_massoc k ([color=BLUE]cdr[/color] ([color=BLUE]member[/color] p l))))
       )
   )

   ([color=BLUE]defun[/color] _pointaverage ( l [color=BLUE]/[/color] x )
       ([color=BLUE]setq[/color] x ([color=BLUE]length[/color] l)) 
       ([color=BLUE]mapcar[/color] '[color=BLUE]/[/color] ([color=BLUE]apply[/color] '[color=BLUE]mapcar[/color] ([color=BLUE]cons[/color] '[color=BLUE]+[/color] l)) ([color=BLUE]list[/color] x x))
   )

   ([color=BLUE]if[/color] ([color=BLUE]setq[/color] s ([color=BLUE]ssget[/color] [color=MAROON]"_:L"[/color] '((0 . [color=MAROON]"LWPOLYLINE"[/color]) (-4 . [color=MAROON]"&="[/color]) (70 . 1))))
       ([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] i ([color=BLUE]sslength[/color] s))
           ([color=BLUE]setq[/color] e ([color=BLUE]entget[/color] ([color=BLUE]ssname[/color] s ([color=BLUE]setq[/color] i ([color=BLUE]1-[/color] i)))))
           ([color=BLUE]if[/color] ([color=BLUE]entmake[/color]
                   ([color=BLUE]list[/color]
                      '(0 . [color=MAROON]"CIRCLE"[/color])
                       ([color=BLUE]assoc[/color] 008 e)
                       ([color=BLUE]cons[/color]  010 (_pointaverage (_massoc 10 e)))
                       ([color=BLUE]cons[/color]  040 r)
                       ([color=BLUE]cond[/color] (([color=BLUE]assoc[/color] 006 e)) ('(006 . [color=MAROON]"BYLAYER"[/color])))
                       ([color=BLUE]cond[/color] (([color=BLUE]assoc[/color] 039 e)) ('(039 . 0.0)))
                       ([color=BLUE]cond[/color] (([color=BLUE]assoc[/color] 062 e)) ('(062 . 256)))
                       ([color=BLUE]cond[/color] (([color=BLUE]assoc[/color] 370 e)) ('(370 . -1)))
                       ([color=BLUE]assoc[/color] 210 e)
                       ([color=BLUE]assoc[/color] 410 e)
                   )
               )
               ([color=BLUE]entdel[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] -1 e)))
           )
       )
   )
   ([color=BLUE]princ[/color])
)

Assumes Closed LWPolylines.

June 25, 2012

Tharwat, a couple of questions about your code if I may:

1)

(ssget "_:L" '((0 . "*POLYLINE") (-4 . "&") (70 . 1)))

You are allowing the user to select both LWPolylines and Polylines, however, your program will not correctly process Polylines.

2)

     (vl-remove-if-not
       '(lambda (x)
          (if (eq (car x) 10)
            (setq pt (cons (list (cadr x) (caddr x)) pt))
          )
        )
       (entget sn)
     )

I cannot understand your use of vl-remove-if-not here since you are not using the return of this function in any way, but rather constructing the output as the list is iterated?

June 25, 2012

Try this ...

(defun c:Test (/ ss i sn pt)
(if (setq ss (ssget "_:L" '((0 . "*POLYLINE") (-4 . "&") (70 . 1))))
(repeat (setq i (sslength ss))
(setq sn (ssname ss (setq i (1- i))))
(vl-remove-if-not
'(lambda (x)
(if (eq (car x) 10)
(setq pt (cons (list (cadr x) (caddr x)) pt))
)
)
(entget sn)
)
(entmakex (list '(0 . "CIRCLE")
(cons 10
(mapcar '(lambda (p q) (/ (+ p q) 2.))
(nth 0 pt)
(nth 2 pt)
)
)
'(40 . 0.2)
)
)
(entdel (cdr (assoc -1 (entget sn))))
)
)
(princ)
)

Tharwat, thanks for your reply.

Your routine works only with LWPolylines. With Polyline does not run.

June 25, 2012

Quick 'n dirty, using the average of the polyline vertices as the circle centre:

([color=blue]defun[/color] c:p2c ( [color=blue]/[/color] _massoc _pointaverage e i r s )

([color=blue]setq[/color] r 0.1) [color=green];; Circle Radius[/color]

([color=blue]defun[/color] _massoc ( k l [color=blue]/[/color] p )
([color=blue]if[/color] ([color=blue]setq[/color] p ([color=blue]assoc[/color] k l))
([color=blue]cons[/color] ([color=blue]cdr[/color] p) (_massoc k ([color=blue]cdr[/color] ([color=blue]member[/color] p l))))
)
)

([color=blue]defun[/color] _pointaverage ( l [color=blue]/[/color] x )
([color=blue]setq[/color] x ([color=blue]length[/color] l)) 
([color=blue]mapcar[/color] '[color=blue]/[/color] ([color=blue]apply[/color] '[color=blue]mapcar[/color] ([color=blue]cons[/color] '[color=blue]+[/color] l)) ([color=blue]list[/color] x x))
)

([color=blue]if[/color] ([color=blue]setq[/color] s ([color=blue]ssget[/color] [color=maroon]"_:L"[/color] '((0 . [color=maroon]"LWPOLYLINE"[/color]) (-4 . [color=maroon]"&="[/color]) (70 . 1))))
([color=blue]repeat[/color] ([color=blue]setq[/color] i ([color=blue]sslength[/color] s))
([color=blue]setq[/color] e ([color=blue]entget[/color] ([color=blue]ssname[/color] s ([color=blue]setq[/color] i ([color=blue]1-[/color] i)))))
([color=blue]if[/color] ([color=blue]entmake[/color]
([color=blue]list[/color]
'(0 . [color=maroon]"CIRCLE"[/color])
([color=blue]assoc[/color] 008 e)
([color=blue]cons[/color] 010 (_pointaverage (_massoc 10 e)))
([color=blue]cons[/color] 040 r)
([color=blue]cond[/color] (([color=blue]assoc[/color] 006 e)) ('(006 . [color=maroon]"BYLAYER"[/color])))
([color=blue]cond[/color] (([color=blue]assoc[/color] 039 e)) ('(039 . 0.0)))
([color=blue]cond[/color] (([color=blue]assoc[/color] 062 e)) ('(062 . 256)))
([color=blue]cond[/color] (([color=blue]assoc[/color] 370 e)) ('(370 . -1)))
([color=blue]assoc[/color] 210 e)
([color=blue]assoc[/color] 410 e)
)
)
([color=blue]entdel[/color] ([color=blue]cdr[/color] ([color=blue]assoc[/color] -1 e)))
)
)
)
([color=blue]princ[/color])
)

Assumes Closed LWPolylines.

Lee, thanks for your reply

Your routine works only with LWPolylines.

(if (setq s (ssget "_:L" '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1))))

June 25, 2012

Your routine works only with LWPolylines.

Just select all old type polylines (if any) using QSELECT or FILTER and call CONVERTPOLY command to fix them. Then apply Lee's routine.

June 25, 2012

Tharwat, a couple of questions about your code if I may:

1) You are allowing the user to select both LWPolylines and Polylines, however, your program will not correctly process Polylines.

I may should have added the equal symbol as used in yours , but throughout all my tries , I didn't face any fault or a break down of this usage , although that I don't understand deeply the use of the "&" .

2) I cannot understand your use of vl-remove-if-not here since you are not using the return of this function in any way, but rather constructing the output as the list is iterated?

I may also should have used mapcar with lambda instead which is would perform much better and faster , although the use of vl-remove-if-not function did the trick without a mistake .

I am usually got or approve the usage of functions by tries mostly , and it could be right and could be wrong .

Thanks

June 25, 2012

Just select all old type polylines (if any) using QSELECT or FILTER and call CONVERTPOLY command to fix them. Then apply Lee's routine.

With CONVERTPOLY command I can convert Polylines to LWPolylines, but even so Lee's routine does not work.

June 25, 2012

Out of curiosity, which is the source of those old type polylines? Are your drawings exported from a third-part application or are very old? If I'm not wrong, AutoCAD's built-in commands generate LW polylines since version 14.

June 25, 2012

Out of curiosity, which is the source of those old type polylines? Are your drawings exported from a third-part application or are very old? If I'm not wrong, AutoCAD's built-in commands generate LW polylines since version 14.

Drawings imported from a third-part application.

June 25, 2012

Then may be useful to post an example drawing here - with just few items.

June 25, 2012

I wonder why the first routine did not work for you , but anyway try this .....

(defun c:Test (/ ss i sn pt r spc vl)
 (vl-load-com)
;;; Tharwat 25 . June . 2012 ;;;
 (if (not acdoc)
   (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
 )
 (setq spc (if (> (vla-get-activespace acdoc) 0)
             (vla-get-modelspace acdoc)
             (vla-get-paperspace acdoc)
           )
 )
 (if (setq ss (ssget "_:L" '((0 . "*POLYLINE"))))
   (progn
     (repeat (setq i (sslength ss))
       (setq sn (ssname ss (setq i (1- i))))
       (if (vlax-curve-isclosed (setq vl (vlax-ename->vla-object sn)))
         (progn
           (entmakex
             (list
               '(0 . "CIRCLE")
               (cons 10
                     (vlax-safearray->list
                       (vlax-variant-value
                         (vla-get-Centroid
                           (setq r
                                  (car (vlax-invoke spc 'addregion (list vl)))
                           )
                         )
                       )
                     )
               )
               '(40 . 2.0)
             )
           )
           (entdel (cdr (assoc -1 (entget sn))))
           (vla-delete r)
         )
       )
     )
   )
 )
 (princ)
)

June 25, 2012

I wonder why the first routine did not work for you , but anyway try this .....

(defun c:Test (/ ss i sn pt r spc vl)
(vl-load-com)
;;; Tharwat 25 . June . 2012 ;;;
(if (not acdoc)
(setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
)
(setq spc (if (> (vla-get-activespace acdoc) 0)
(vla-get-modelspace acdoc)
(vla-get-paperspace acdoc)
)
)
(if (setq ss (ssget "_:L" '((0 . "*POLYLINE"))))
(progn
(repeat (setq i (sslength ss))
(setq sn (ssname ss (setq i (1- i))))
(if (vlax-curve-isclosed (setq vl (vlax-ename->vla-object sn)))
(progn
(entmakex
(list
'(0 . "CIRCLE")
(cons 10
(vlax-safearray->list
(vlax-variant-value
(vla-get-Centroid
(setq r
(car (vlax-invoke spc 'addregion (list vl)))
)
)
)
)
)
'(40 . 2.0)
)
)
(entdel (cdr (assoc -1 (entget sn))))
(vla-delete r)
)
)
)
)
)
(princ)
)

Unfortunately it did not work.

You can check with attached drawing?

Thanks.

POLY_CIR.dwg

June 26, 2012

Unfortunately it did not work.
You can check with attached drawing?

Thanks.

Codes are not working because the polylines are opened and not closed .

June 26, 2012

Codes are not working because the polylines are opened and not closed .

Tharwat, I apologize for my mistake and thank you very much for your attention.

The fact is that objects have LWPolylines and Polylines as in the example and need to convert in circles.

If anyone knows how to do so would greatly appreciate it.

June 26, 2012

Try the following:

([color=BLUE]defun[/color] c:p2c ( [color=BLUE]/[/color] _vertices _vertices1 _vertices2 _pointaverage e i r s )

   ([color=BLUE]setq[/color] r 0.1) [color=GREEN];; Circle Radius[/color]

   ([color=BLUE]defun[/color] _vertices ( l )
       ([color=BLUE]if[/color] ([color=BLUE]eq[/color] [color=MAROON]"LWPOLYLINE"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 l)))
           (_vertices1 l)
           (_vertices2 ([color=BLUE]entnext[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] -1 l))))
       )
   )
   
   ([color=BLUE]defun[/color] _vertices1 ( l [color=BLUE]/[/color] p )
       ([color=BLUE]if[/color] ([color=BLUE]setq[/color] p ([color=BLUE]assoc[/color] 10 l))
           ([color=BLUE]cons[/color] ([color=BLUE]cdr[/color] p) (_vertices1 ([color=BLUE]cdr[/color] ([color=BLUE]member[/color] p l))))
       )
   )

   ([color=BLUE]defun[/color] _vertices2 ( e )
       ([color=BLUE]if[/color] ([color=BLUE]eq[/color] [color=MAROON]"VERTEX"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 ([color=BLUE]entget[/color] e))))
           ([color=BLUE]cons[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 10 ([color=BLUE]entget[/color] e))) (_vertices2 ([color=BLUE]entnext[/color] e)))
       )
   )
   
   ([color=BLUE]defun[/color] _pointaverage ( l [color=BLUE]/[/color] x )
       ([color=BLUE]setq[/color] x ([color=BLUE]length[/color] l)) 
       ([color=BLUE]mapcar[/color] '[color=BLUE]/[/color] ([color=BLUE]apply[/color] '[color=BLUE]mapcar[/color] ([color=BLUE]cons[/color] '[color=BLUE]+[/color] l)) ([color=BLUE]list[/color] x x))
   )

   ([color=BLUE]if[/color] ([color=BLUE]setq[/color] s ([color=BLUE]ssget[/color] [color=MAROON]"_:L"[/color] '((0 . [color=MAROON]"*POLYLINE"[/color]))))
       ([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] i ([color=BLUE]sslength[/color] s))
           ([color=BLUE]setq[/color] e ([color=BLUE]entget[/color] ([color=BLUE]ssname[/color] s ([color=BLUE]setq[/color] i ([color=BLUE]1-[/color] i)))))
           ([color=BLUE]if[/color] ([color=BLUE]entmake[/color]
                   ([color=BLUE]list[/color]
                      '(0 . [color=MAROON]"CIRCLE"[/color])
                       ([color=BLUE]assoc[/color] 008 e)
                       ([color=BLUE]cons[/color]  010 (_pointaverage (_vertices e)))
                       ([color=BLUE]cons[/color]  040 r)
                       ([color=BLUE]cond[/color] (([color=BLUE]assoc[/color] 006 e)) ('(006 . [color=MAROON]"BYLAYER"[/color])))
                       ([color=BLUE]cond[/color] (([color=BLUE]assoc[/color] 039 e)) ('(039 . 0.0)))
                       ([color=BLUE]cond[/color] (([color=BLUE]assoc[/color] 062 e)) ('(062 . 256)))
                       ([color=BLUE]cond[/color] (([color=BLUE]assoc[/color] 370 e)) ('(370 . -1)))
                       ([color=BLUE]assoc[/color] 210 e)
                       ([color=BLUE]assoc[/color] 410 e)
                   )
               )
               ([color=BLUE]entdel[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] -1 e)))
           )
       )
   )
   ([color=BLUE]princ[/color])
)

June 26, 2012

A case of duplicate points...

(defun c:p2c ( / _vertices _vertices1 _vertices2 _uniquefuzz _pointaverage e i r s )

   (setq r 0.1) ;; Circle Radius

   (defun _vertices ( l )
       (if (eq "LWPOLYLINE" (cdr (assoc 0 l)))
           (_vertices1 l)
           (_vertices2 (entnext (cdr (assoc -1 l))))
       )
   )
   
   (defun _vertices1 ( l / p )
       (if (setq p (assoc 10 l))
           (cons (cdr p) (_vertices1 (cdr (member p l))))
       )
   )

   (defun _vertices2 ( e )
       (if (eq "VERTEX" (cdr (assoc 0 (entget e))))
           (cons (cdr (assoc 10 (entget e))) (_vertices2 (entnext e)))
       )
   )

   (defun _uniquefuzz ( l f )
       (if l
           (cons (car l)
               (_uniquefuzz
                   (vl-remove-if '(lambda ( x ) (equal x (car l) f)) (cdr l))
                   f
               )
           )
       )
   )
   
   (defun _pointaverage ( l / x )
       (setq x (length l)) 
       (mapcar '/ (apply 'mapcar (cons '+ l)) (list x x))
   )

   (if (setq s (ssget "_:L" '((0 . "*POLYLINE"))))
       (repeat (setq i (sslength s))
           (setq e (entget (ssname s (setq i (1- i)))))
           (if (entmake
                   (list
                      '(0 . "CIRCLE")
                       (assoc 008 e)
                       (cons  010 (_pointaverage (_uniquefuzz (_vertices e) 1e-))
                       (cons  040 r)
                       (cond ((assoc 006 e)) ('(006 . "BYLAYER")))
                       (cond ((assoc 039 e)) ('(039 . 0.0)))
                       (cond ((assoc 062 e)) ('(062 . 256)))
                       (cond ((assoc 370 e)) ('(370 . -1)))
                       (assoc 210 e)
                       (assoc 410 e)
                   )
               )
               (entdel (cdr (assoc -1 e)))
           )
       )
   )
   (princ)
)

June 26, 2012

A case of duplicate points...

(defun c:p2c ( / _vertices _vertices1 _vertices2 _uniquefuzz _pointaverage e i r s )

(setq r 0.1) ;; Circle Radius

(defun _vertices ( l )
(if (eq "LWPOLYLINE" (cdr (assoc 0 l)))
(_vertices1 l)
(_vertices2 (entnext (cdr (assoc -1 l))))
)
)

(defun _vertices1 ( l / p )
(if (setq p (assoc 10 l))
(cons (cdr p) (_vertices1 (cdr (member p l))))
)
)

(defun _vertices2 ( e )
(if (eq "VERTEX" (cdr (assoc 0 (entget e))))
(cons (cdr (assoc 10 (entget e))) (_vertices2 (entnext e)))
)
)

(defun _uniquefuzz ( l f )
(if l
(cons (car l)
(_uniquefuzz
(vl-remove-if '(lambda ( x ) (equal x (car l) f)) (cdr l))
f
)
)
)
)

(defun _pointaverage ( l / x )
(setq x (length l)) 
(mapcar '/ (apply 'mapcar (cons '+ l)) (list x x))
)

(if (setq s (ssget "_:L" '((0 . "*POLYLINE"))))
(repeat (setq i (sslength s))
(setq e (entget (ssname s (setq i (1- i)))))
(if (entmake
(list
'(0 . "CIRCLE")
(assoc 008 e)
(cons 010 (_pointaverage (_uniquefuzz (_vertices e) 1e-))
(cons 040 r)
(cond ((assoc 006 e)) ('(006 . "BYLAYER")))
(cond ((assoc 039 e)) ('(039 . 0.0)))
(cond ((assoc 062 e)) ('(062 . 256)))
(cond ((assoc 370 e)) ('(370 . -1)))
(assoc 210 e)
(assoc 410 e)
)
)
(entdel (cdr (assoc -1 e)))
)
)
)
(princ)
)

Lee,

The code works very well.

Thank you very much for your attention.

Regards.

Sign In

I need a lisp to change closed polylines to circles

Recommended Posts

antistar

Tharwat

Lee Mac

Lee Mac

antistar

antistar

MSasu

Tharwat

antistar

MSasu

antistar

MSasu

Tharwat

antistar

Tharwat

antistar

Lee Mac

Lee Mac

antistar

Join the conversation

Tutorials

Forums

Activity