Jump to content

I need a lisp to change closed polylines to circles

antistar

By antistar
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

antistar Enthusiast

antistar

Posted
Posted

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

Circles1.PNG

Tharwat Grand Master

Tharwat

Posted
Posted

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

Lee Mac Grand Master

Lee Mac

Posted
Posted

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 Mac Grand Master

Lee Mac

Posted
Posted

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?

antistar Enthusiast

antistar

Posted
  • Author
Posted
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.

antistar Enthusiast

antistar

Posted
  • Author
Posted
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))))

MSasu Grand Master

MSasu

Posted
Posted
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.

Tharwat Grand Master

Tharwat

Posted
Posted
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

antistar Enthusiast

antistar

Posted
  • Author
Posted
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.

MSasu Grand Master

MSasu

Posted
Posted

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.

antistar Enthusiast

antistar

Posted
  • Author
Posted
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.

MSasu Grand Master

MSasu

Posted
Posted

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

Tharwat Grand Master

Tharwat

Posted
Posted

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

antistar Enthusiast

antistar

Posted
  • Author
Posted
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

Tharwat Grand Master

Tharwat

Posted
Posted
Unfortunately it did not work.

You can check with attached drawing?

Thanks.

 

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

antistar Enthusiast

antistar

Posted
  • Author
Posted
Codes are not working because the polylines are opened and not closed . :x

 

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.

Lee Mac Grand Master

Lee Mac

Posted
Posted

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

Lee Mac Grand Master

Lee Mac

Posted
Posted

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

antistar Enthusiast

antistar

Posted
  • Author
Posted
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.

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...