Circles to Points

December 24, 2008

I have to change a bunch of circles to points so that the dxf can be uploaded to a CNC router (for drilling). Anyone know of a way to quickly select all circles then change them to points or at the very least add points to the center of each circle?

December 24, 2008

Merry Christmas

(defun c:test ()
 (setvar "cmdecho" 0)
 (setq    ss1   (ssget '((0 . "circle")))
   sslen (sslength ss1)
   cnt   0
 )
 (if
   (> sslen 32767)
    (alert "You've selected more than 32,767 circles!!!")
    (progn
      (repeat sslen
    (setq ename (ssname ss1 cnt)
          edata (entget ename)
          rp    (cdr (assoc 10 edata))
    )
    ;(command "point" rp)
(entmake (list (cons 0 "point")
          (cons 10 rp)
        )
   )
    (setq cnt (1+ cnt))
    (entdel ename)            ;remove this line if you want to keep the circles
      )
    )
 )
 (setvar "cmdecho" 1)
 (princ)
)

December 25, 2008

1 opening brack missed ~ Merry Christmas lpseifert

;Circles to Points by Lpseifert

(defun c:test (/ ss1 sslen cnt ename edata rp)
   (setq ss1    (ssget '((0 . "circle")))
     sslen    (sslength ss1)
     cnt    0
   ) ;_  end setq
   (repeat sslen
   (setq ename (ssname ss1 cnt)
         edata (entget ename)
         rp    (cdr (assoc 10 edata))
   ) ;_  end setq
   (command "point" rp)
   (setq cnt (1+ cnt))
   (entdel ename) ;remove this line if you want to keep the circles
   ) ;_  end repeat
   (princ)
) ;_  end defun

December 25, 2008

Just as an aside, if there are more than 32767 entities in a PICKSET, (sslength) returns a real, not an integer as the documentation states

and will make (repeat) crash due to a bad argument.

Happy Holidays! -David

PS At least it did up until A2K

December 26, 2008

Try it

The program changes a set of primitive things for the chosen primitive thing.

Application examples:

Replacement of one blocks with others.

Replacement of points with blocks or circles.

Replacement of one inscriptions with others.

At first it is necessary to choose replaced objects and to press Enter, then to specify replacing object. The insert is made in the centre of a limiting (dimensional) rectangle of old objects. New objects are inserted into layers which to which old objects belonged.

This programm posted {Smirnoff} (on this forum known as ASMI) here

(defun c:frto(/ ACTDOC COPOBJ ERRCOUNT EXTLST
      EXTSET FROMCEN LAYCOL MAXPT CURLAY
      MINPT OBJLAY OKCOUNT OLAYST
      SCLAY TOCEN TOOBJ VLAOBJ *ERROR*)

 (vl-load-com)

 (defun *ERROR*(msg)
   (if olaySt
     (vla-put-Lock objLay olaySt)
     ); end if
   (vla-EndUndoMark actDoc)
   (princ)
   ); end of *ERROR*


 (defun GetBoundingCenter(vlaObj / blPt trPt cnPt)
 (vla-GetBoundingBox vlaObj 'minPt 'maxPt)
     (setq blPt(vlax-safearray->list minPt)
     trPt(vlax-safearray->list maxPt)
     cnPt(vlax-3D-point
     (list
           (+(car blPt)(/(-(car trPt)(car blPt))2))
           (+(cadr blPt)(/(-(cadr trPt)(cadr blPt))2))
        0.0
           ); end list
    ); end vlax-3D-point
   ); end setq
 ); end of GetBoundingCenter

 (if(not(setq extSet(ssget "_I")))
   (progn
     (princ "\n+++ Select distination objects and press Enter <- ")
     (setq extSet(ssget))
     ); end progn
   ); end if
 (if(not extSet)
   (princ "\nDistination objects isn't selected!")
   ); end if
 (if
   (and
   extSet
   (setq toObj(entsel "\n+++ Select source object -> "))
   ); and and
   (progn
     (setq actDoc
      (vla-get-ActiveDocument
        (vlax-get-Acad-object))
     layCol
      (vla-get-Layers actDoc)
     extLst
      (mapcar 'vlax-ename->vla-object
                   (vl-remove-if 'listp
                    (mapcar 'cadr(ssnamex extSet))))
     vlaObj(vlax-ename->vla-object(car toObj))
     objLay(vla-Item layCol
         (vla-get-Layer vlaObj))
     olaySt(vla-get-Lock objLay)
     fromCen(GetBoundingCenter vlaObj)
     errCount 0
     okCount 0
     ); end setq
     (vla-StartUndoMark actDoc)
     (foreach obj extLst
 (setq toCen(GetBoundingCenter obj)
       scLay(vla-Item layCol
          (vla-get-Layer obj))
          );end setq
 (if(/= :vlax-true(vla-get-Lock scLay))
   (progn
   (setq curLay(vla-get-Layer obj))
   (vla-put-Lock objLay :vlax-false)
   (setq copObj(vla-copy vlaObj))
   (vla-Move copObj fromCen toCen)
   (vla-put-Layer copObj curLay)
   (vla-put-Lock objLay olaySt)
   (vla-Delete obj)
   (setq okCount(1+ okCount))
   ); end progn
   (setq errCount(1+ errCount))
   ); end if
 ); end foreach
     (princ
 (strcat "\n" (itoa okCount) " were changed. "
   (if(/= 0 errCount)
     (strcat (itoa errCount) " were on locked layer! ")
     ""
     ); end if
   ); end strcat
 ); end princ
     (vla-EndUndoMark actDoc)
     ); end progn
   (princ "\nSource object isn't selected! ")
   ); end if
 (princ)
 ); end of c:frto

January 1, 2009

Hi guys for Lee Mac as above a simple bracket checker nothing worse than when you write code and you have to find a missing bracket it can often be frustrating.

(defun c:chkbrk (/ opf bkt chekdfile rdctl wkfile currentln wln ltr ncln)
(setvar "cmdecho" 0)
(prompt "\nlook at end of line")
;(setq chekdfile (getstring "enter name of file :"))
(SETQ chekdfile (getfiled "Enter file name:" " " "LSP" 4))

(setq opf (open chekdfile "r"))
(setq bkt 0)
(setq blkl 0)
(setq rdctl 1)
(setq wkfile (open "wow.lsp" "w"))

(setq currentln "a")
(while (/= blkl 6)
(setq currentln (read-line opf))
(if (= currentln nil)(setq currentln ""))
(if (= currentln "")(setq blkl (+ 1 blkl))(setq blkl 1))
(setq wln currentln)                                                        
(while (/= wln "")
       (setq ltr (substr wln 1 1))
       (setq wln (substr wln 2))
       (cond ((= (ascii ltr) 34) (if (= rdctl 0)(setq rdctl 1)(setq rdctl 0)))
               ((and (= ltr "(")(= rdctl 1))(setq bkt (+ bkt 1)))
               ((and (= ltr ")")(= rdctl 1))(setq bkt (- bkt 1)))
               ((and (= ltr ";")(= rdctl 1))(setq wln ""))
               ;(t (prompt ltr))
       )
)
(setq ncln (strcat currentln ";" (itoa bkt)
(princ (itoa bkt))
(if (= rdctl 0) "string open" "")))
(if (/= currentln "")(write-line ncln wkfile))
)
(close wkfile)
(close opf)
(prompt (strcat "open brakets= " (itoa bkt) "."))
)


     ang1 nil
     pt1 nil
     pt2 nil
     pt3 nil
     pt4 nil
     pt5 nil)

(princ)

January 1, 2009

With list instead selection set:

(defun c:ctp(/ cSet)
 (and(setq cSet(ssget '((0 . "CIRCLE"))))
 (mapcar '(lambda(x)(vl-cmdf "_.POINT"(cdr(assoc 10(entget x))))(entdel x))
 (vl-remove-if 'listp(mapcar 'cadr(ssnamex cSet)))))
 (princ)
 ); end of c:ctp

January 1, 2009

AS IS

[b][color=BLACK]([/color][/b]defun c:cir2poi [b][color=FUCHSIA]([/color][/b]/ ss i en ed nd[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]while [b][color=BLUE]([/color][/b]not ss[b][color=BLUE])[/color][/b]
        [b][color=BLUE]([/color][/b]princ "\nSelect CIRCLEs To Convert To POINTs..."[b][color=BLUE])[/color][/b]
        [b][color=BLUE]([/color][/b]setq ss [b][color=AQUA]([/color][/b]ssget '[b][color=GREEN]([/color][/b][b][color=YELLOW]([/color][/b]0 . "CIRCLE"[b][color=YELLOW])[/color][/b][b][color=GREEN])[/color][/b][b][color=AQUA])[/color][/b][b][color=BLUE])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]setq i [b][color=BLUE]([/color][/b]sslength ss[b][color=BLUE])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]while [b][color=BLUE]([/color][/b]not [b][color=AQUA]([/color][/b]minusp [b][color=GREEN]([/color][/b]setq i [b][color=YELLOW]([/color][/b]1- i[b][color=YELLOW])[/color][/b][b][color=GREEN])[/color][/b][b][color=AQUA])[/color][/b][b][color=BLUE])[/color][/b]
        [b][color=BLUE]([/color][/b]setq en [b][color=AQUA]([/color][/b]ssname ss i[b][color=AQUA])[/color][/b]
              ed [b][color=AQUA]([/color][/b]entget en[b][color=AQUA])[/color][/b]
              nd '[b][color=AQUA]([/color][/b][b][color=GREEN]([/color][/b]0 . "POINT"[b][color=GREEN])[/color][/b][b][color=AQUA])[/color][/b][b][color=BLUE])[/color][/b]
        [b][color=BLUE]([/color][/b]foreach g '[b][color=AQUA]([/color][/b]6 8 10 39 48 62 210[b][color=AQUA])[/color][/b]
           [b][color=AQUA]([/color][/b]if [b][color=GREEN]([/color][/b]assoc g ed[b][color=GREEN])[/color][/b]
               [b][color=GREEN]([/color][/b]setq nd [b][color=YELLOW]([/color][/b]cons [b][color=RED]([/color][/b]cons g [b][color=GRAY]([/color][/b]cdr [b][color=#CC00CC]([/color][/b]assoc g ed[b][color=#CC00CC])[/color][/b][b][color=GRAY])[/color][/b][b][color=RED])[/color][/b] nd[b][color=YELLOW])[/color][/b][b][color=GREEN])[/color][/b][b][color=AQUA])[/color][/b][b][color=BLUE])[/color][/b]
        [b][color=BLUE]([/color][/b]setq nd [b][color=AQUA]([/color][/b]reverse nd[b][color=AQUA])[/color][/b][b][color=BLUE])[/color][/b]
        [b][color=BLUE]([/color][/b]entmake nd[b][color=BLUE])[/color][/b]
        [b][color=BLUE]([/color][/b]entdel en[b][color=BLUE])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]redraw[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]prin1[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

The colors need some tweaking. -David

January 1, 2009

I think we all missed that group 10 for CIRCLEs are OCS while group 10 for POINTs are WCS

AS IS

[b][color=BLACK]([/color][/b]defun c:cir2poi [b][color=FUCHSIA]([/color][/b]/ ss i en ed nd[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]while [b][color=NAVY]([/color][/b]not ss[b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]princ "\nSelect CIRCLEs To Convert To POINTs..."[b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]setq ss [b][color=RED]([/color][/b]ssget '[b][color=BLUE]([/color][/b][b][color=TEAL]([/color][/b]0 . "CIRCLE"[b][color=TEAL])[/color][/b][b][color=BLUE])[/color][/b][b][color=RED])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]setq i [b][color=NAVY]([/color][/b]sslength ss[b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]while [b][color=NAVY]([/color][/b]not [b][color=RED]([/color][/b]minusp [b][color=BLUE]([/color][/b]setq i [b][color=TEAL]([/color][/b]1- i[b][color=TEAL])[/color][/b][b][color=BLUE])[/color][/b][b][color=RED])[/color][/b][b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]setq en [b][color=RED]([/color][/b]ssname ss i[b][color=RED])[/color][/b]
              ed [b][color=RED]([/color][/b]entget en[b][color=RED])[/color][/b]
              nd [b][color=RED]([/color][/b]list [b][color=BLUE]([/color][/b]cons 10 [b][color=TEAL]([/color][/b]trans [b][color=MAROON]([/color][/b]cdr [b][color=OLIVE]([/color][/b]assoc 10 ed[b][color=OLIVE])[/color][/b][b][color=MAROON])[/color][/b] en 0[b][color=TEAL])[/color][/b][b][color=BLUE])[/color][/b]
                       [b][color=BLUE]([/color][/b]cons 0  "POINT"[b][color=BLUE])[/color][/b][b][color=RED])[/color][/b][b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]foreach g '[b][color=RED]([/color][/b]6 8 39 48 62 210[b][color=RED])[/color][/b]
           [b][color=RED]([/color][/b]if [b][color=BLUE]([/color][/b]assoc g ed[b][color=BLUE])[/color][/b]
               [b][color=BLUE]([/color][/b]setq nd [b][color=TEAL]([/color][/b]cons [b][color=MAROON]([/color][/b]cons g [b][color=OLIVE]([/color][/b]cdr [b][color=GRAY]([/color][/b]assoc g ed[b][color=GRAY])[/color][/b][b][color=OLIVE])[/color][/b][b][color=MAROON])[/color][/b] nd[b][color=TEAL])[/color][/b][b][color=BLUE])[/color][/b][b][color=RED])[/color][/b][b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]entmake [b][color=RED]([/color][/b]reverse nd[b][color=RED])[/color][/b][b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]entdel en[b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]redraw[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]prin1[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

-David

January 1, 2009

David,

For starters, nice routine - I like the way you "convert" the circles to points using the DXF references instead of just the inbuilt ACAD point command.

But I do have a question:

Why do you use "prin1" instead of just "princ" to end your routine?

January 1, 2009

Lee,

AutoLISP is a derivative of Common LISP and I think that the original definition comes from there.

From LISP Help as far back as I remember:

Used as the last expression in a function, prin1 without arguments
results in a blank line printing when the function completes, allowing the
function to exit "quietly."

After that it is just a habit. -David

January 1, 2009

Ahh I see, thanks David.

I suppose it is just another variation ~ like terpri that is sometimes used in old LISP routines.

I suppose used on their own (princ) and (prin1) don't differ in function, and achieve the same desired clean exit.

Thanks for the help.

January 2, 2009

Something like that.

(terpri) is used for screen calls only, whereas (prin__) functions were originally focused on I/O outputs.

The big difference in the 2 is that (terpri) returns nil and (princ "\n") returns "\n".

Common LISP is a very old computer language, AutoLISP was first introduced in the mid '80. Not much screen usage back in the '50s. -David

January 2, 2009

Thanks David.

April 9, 2009

Please excuse my inexperience here but how do I use the code that you so kindly posted here for me. I tried to turn it into a script but that did not seem to work for me.

April 9, 2009

http://www.cadtutor.net/faq/questions/28/How+do+I+use+an+AutoLISP+routine%3F

Sign In

Circles to Points

Recommended Posts

big daddy

lpseifert

Lee Mac

David Bethel

VVA

BIGAL

ASMI

David Bethel

David Bethel

Lee Mac

David Bethel

Lee Mac

David Bethel

Lee Mac

big daddy

lpseifert

Join the conversation

Tutorials

Forums

Activity