Jump to content

Multiple circle with multiple layers in autolisp


SSA

Recommended Posts

Hello, :)

I'm new in AutoCAD (for about a week now) and have a favor to ask.

 

I have to draw hundrads of circles in IntelliCAD.

Does anyone know how to automate it using autolisp? so that I can write in text file and load it automaticaly.

 

I have the coordinates and the radius for each circle. Each circle will be drawn in different layer (each circle should have its own layer, so that it can be turned off and on for printing purpose)

 

As for now I'm using this command:

(command "_.circle""20,10""1") it works so far but it takes forever. :cry:

 

Thank you in advance for your time and help!!

 

 

SSA

Link to comment
Share on other sites

  • Replies 32
  • Created
  • Last Reply

Top Posters In This Topic

  • Lee Mac

    16

  • SSA

    14

  • JohnM

    3

Top Posters In This Topic

Hi Lee mac,

 

I have the coordinates and radius in the excel file. I guess if I can input all the coordinates and radius in text file, no matter what the format is?

 

I found this example to generate a circle using autolisp from daily autoCAD website but it gives me an error: null function

 

(defunc C:make_circle (/v1) ; first construct our entity list

(setq v1 (list)

(cons 0 "circle") ; name of entity

(cons 8 "TAL_LINE") ; name of its layer

(cons 10 '(5.0 10.0); center point of circle

(cons 40 (2.5)) ; radius of circle

) ; end of entity list

)

(entmake v1) ; create circle

)

 

Please advise

Thanks

Link to comment
Share on other sites

Sorry, what I meant was: what order is the information in?

 

i.e.

 

Coordinates,Radius

 

Radius,Coordinates

 

Could you provide a sample of how the information is stored, and this should be able to be accomplished quite easily.

 

As for the other function, the (list) has no arguments,.

Link to comment
Share on other sites

I wasn't sure of the way your coordinates were displayed, so this makes a few assumptions:

 

  • Data is read from a TXT file
  • Coordinates and Radius are separated by a space
  • Coordinates are comma delimited.

(defun c:CirMake (/ file nl)
 (vl-load-com)
 (if (setq file (getfiled "Select Text File to Read" "" "txt" )
   (progn
     (setq file (open file "r"))
     (while (setq nl (read-line file))        
       (command "_.circle" "_non"
                (substr nl 1 (vl-string-position 32 nl))
                (substr nl (+ (vl-string-position 32 nl) 2))))
     (close file))
   (princ "\n<!> No File Selected <!>"))
 (princ))

Link to comment
Share on other sites

Sorry for the confusion, what I meant was I have the coordinates and the radius in excel.

I'm trying to write lisp that contained all those coordinates and radius, so i can generate the circles automaticaly (trying to avoid entering the circle commands one by one). Each circle will have its on layer.

 

for example in excel I have

x y r

10' 10' 1'

20' 20' 2'

30' 30' 3'

etc...

 

That's what I have in mind, do you have other suggestion for this problem?

Link to comment
Share on other sites

Alternatively - save the Excel File as a CSV file :)

 

Yes I just save it in text

do you mind explaning me about the lisp you wrote? maybe with ";" at the end of each line :wink: sorry, I'm not familiar.

 

I tried to run the lisp, it came back with error null function

maybe I'm missing something here?

Thanks

Link to comment
Share on other sites

Yes I just save it in text

do you mind explaning me about the lisp you wrote? maybe with ";" at the end of each line :wink: sorry, I'm not familiar.

 

I tried to run the lisp, it came back with error null function

maybe I'm missing something here?

Thanks

 

As I said it does make a lot of assumptions, it assumes that the info is in the form:

 

x,y,zr

Link to comment
Share on other sites

(defun c:CirMake  (/ file nl) ; Define Function/Localise Variables
 (vl-load-com) ; Load VL functions
 (if ; If the following is true
   (setq file (getfiled "Select Text File to Read" "" "csv" ) ; Select a file
   (progn ; Wrap the following statements
     (setq file (open file "r")) ; Opent the file for reading
     (while ; While the following
       (setq nl (read-line file)) ; Read a line from the file
       (command "_.circle" ; Invoke the circle command
                "_non" ; Ignore OSNAPS
                (substr nl 1 (vl-string-position 9 nl)) ; Detect the Space in the line and get the text before the space
                (substr nl (+ (vl-string-position 9 nl) 2)))) ; Get the text after the space
     (close file)) ; Close the file
   (princ "\n<!> No File Selected <!>")) ; Else no File was selected
 (princ)) ; Exit Cleanly

Link to comment
Share on other sites

Give this a try.

Use notepad to create a text file named ctxt.txt and save it to the C: drive

Format the file as follows:

10,10

1

15,15

2

20.75,16.5

0.75

First the coordinates then the next line is the radius

Load the lisp file and type ccs on the command line

 

 

[font=Times New Roman](defun c:ccs (/ ff cl n ctx opf rln cnt lynum retv)[/font]
[font=Times New Roman] (setq ff (findfile "c:/ctxt.txt"));_look for text file[/font]
[font=Times New Roman] (if ff[/font]
[font=Times New Roman] (progn[/font]
[font=Times New Roman] (command "undo" "be");_set undo marker[/font]
[font=Times New Roman] (setq cl (getvar "clayer"));_get current layer[/font]
[font=Times New Roman] (setq n 1);_while loop killer[/font]
[font=Times New Roman] (setq ctx '());_empty list[/font]
[font=Times New Roman] (setq opf (open ff "r"));_if file found open it[/font]
[font=Times New Roman] (while (= n 1);_loop to read lines of file[/font]
[font=Times New Roman]   (setq rln (read-line opf))[/font]
[font=Times New Roman] (if rln (setq ctx(cons rln ctx))(setq n nil));_if line not nil write to list else kill loop[/font]
[font=Times New Roman]   );_while[/font]
[font=Times New Roman] (close opf);_close file[/font]
[font=Times New Roman] (if ctx  ;_if file has info continue [/font]
[font=Times New Roman]  (progn[/font]
[font=Times New Roman] (setq ctx (reverse ctx));_flip list from file[/font]
[font=Times New Roman] (setq cnt 0);_loop counter[/font]
[font=Times New Roman] (setq lynum 1);_layer number added to end of layer name[/font]
[font=Times New Roman] (while (< cnt (length ctx));_loop through list[/font]
[font=Times New Roman] (setq x (nth cnt ctx));_coordinates[/font]
[font=Times New Roman] (setq r (nth (1+ cnt) ctx));_redius[/font]
[font=Times New Roman] (setq retv (crly lynum));_call to layer maker[/font]
[font=Times New Roman] (setvar "clayer" (nth 0 retv));_set layer to new layer[/font]
[font=Times New Roman] (setq lynum (nth 1 retv));_layer # counter[/font]
[font=Times New Roman] (command "_circle" x r);_make circle[/font]
[font=Times New Roman] (setq cnt (+ cnt 2));_up loop counter by 2[/font]
[font=Times New Roman] (setq lynum (1+ lynum));_up layer number by 1[/font]
[font=Times New Roman] );_while[/font]
[font=Times New Roman]    );_progn  [/font]
[font=Times New Roman] );_if[/font]
[font=Times New Roman] (setvar "clayer" cl);_reset back to old layer[/font]
[font=Times New Roman] (command "undo" "END");_end undo group[/font]
[font=Times New Roman]   );_progn if txt[/font]
[font=Times New Roman]   );_if txt[/font]
[font=Times New Roman]   (princ)[/font]
[font=Times New Roman]  );_defun[/font]
[font=Times New Roman] [/font]
[font=Times New Roman](defun crly (aug1 / lp1 tbs retval)[/font]
[font=Times New Roman] (command "-purge" "LA" "cir-*" "n");_purge any unused circle layers  [/font]
[font=Times New Roman] (setq lp1 1);_loop killer[/font]
[font=Times New Roman] (while (= lp1 1)[/font]
[font=Times New Roman] (setq tbs (tblsearch "layer" (strcat "cir-" (itoa aug1))));_search for layer[/font]
[font=Times New Roman] (if tbs  ;_if found  [/font]
[font=Times New Roman] (setq aug1 (1+ aug1));_up layer # by 1[/font]
[font=Times New Roman] (progn[/font]
[font=Times New Roman] (setq lp1 nil);_kill loop if layer not found[/font]
[font=Times New Roman] (setq retval (strcat "cir-" (itoa aug1)));_new layer name[/font]
[font=Times New Roman] (command "-layer" "n" retval "");_make new layer[/font]
[font=Times New Roman] );_progn[/font]
[font=Times New Roman] );_if[/font]
[font=Times New Roman]   );_while[/font]
[font=Times New Roman] (list retval aug1);_return layer name and layer number[/font]
[font=Times New Roman]);_defun[/font]
[font=Times New Roman][/font]

Link to comment
Share on other sites

If you have copied the contents of the Excel file straight into a txt file, and the format of the data in the Excel file is:

 

x y r

 

as you previously mentioned, then this may work:

 

(defun c:CirMake (/ *error* vlst ovar file nl lst)
 (vl-load-com)

 (defun *error* (msg)
   (if ovar (mapcar 'setvar vlst ovar))
   (if (not (member msg '("Function cancelled" "quit / exit abort")))
     (princ (strcat "\n<< Error: " msg " >>")))
   (princ))

 (setq vlst '("CMDECHO" "OSMODE")
       ovar (mapcar 'getvar vlst))
 (mapcar 'setvar vlst '(0 0))
 (if (setq file (getfiled "Select Text File to Read" "" "txt" )
   (progn
     (setq file (open file "r"))
     (while (setq nl (read-line file))
       (setq lst (StrBrk nl 9))
       (command "_.circle"
                (list (distof (car lst))
                      (distof (cadr lst)) 0.0) (caddr lst)))
     (close file))
   (princ "\n<!> No File Selected <!>"))
 (princ))

(defun StrBrk (str chrc / pos lst)
 (while (setq pos (vl-string-position chrc str))
   (setq lst (cons (substr str 1 pos) lst)
         str (substr str (+ pos 2))))
 (reverse (cons str lst)))

Link to comment
Share on other sites

wow that was wrong way to post

 

 

 
(defun c:ccs (/ ff cl n ctx opf rln cnt lynum retv)
(setq ff (findfile "c:/ctxt.txt"));_look for text file
(if ff
(progn
(command "undo" "be");_set undo marker
(setq cl (getvar "clayer"));_get current layer
(setq n 1);_while loop killer
(setq ctx '());_empty list
(setq opf (open ff "r"));_if file found open it
(while (= n 1);_loop to read lines of file
  (setq rln (read-line opf))
(if rln (setq ctx(cons rln ctx))(setq n nil));_if line not nil write to list else kill loop
  );_while
(close opf);_close file
(if ctx  ;_if file has info continue 
 (progn
(setq ctx (reverse ctx));_flip list from file
(setq cnt 0);_loop counter
(setq lynum 1);_layer number added to end of layer name
(while (< cnt (length ctx));_loop through list
(setq x (nth cnt ctx));_coordinates
(setq r (nth (1+ cnt) ctx));_redius
(setq retv (crly lynum));_call to layer maker
(setvar "clayer" (nth 0 retv));_set layer to new layer
(setq lynum (nth 1 retv));_layer # counter
(command "_circle" x r);_make circle
(setq cnt (+ cnt 2));_up loop counter by 2
(setq lynum (1+ lynum));_up layer number by 1
);_while
   );_progn  
);_if
(setvar "clayer" cl);_reset back to old layer
(command "undo" "END");_end undo group
  );_progn if txt
  );_if txt
  (princ)
 );_defun

(defun crly (aug1 / lp1 tbs retval)
(command "-purge" "LA" "cir-*" "n");_purge any unused circle layers  
(setq lp1 1);_loop killer
(while (= lp1 1)
(setq tbs (tblsearch "layer" (strcat "cir-" (itoa aug1))));_search for layer
(if tbs  ;_if found  
(setq aug1 (1+ aug1));_up layer # by 1
(progn
(setq lp1 nil);_kill loop if layer not found
(setq retval (strcat "cir-" (itoa aug1)));_new layer name
(command "-layer" "n" retval "");_make new layer
);_progn
);_if
  );_while
(list retval aug1);_return layer name and layer number
);_defun

Link to comment
Share on other sites

wow that was wrong way to post

 

 

 
(defun c:ccs (/ ff cl n ctx opf rln cnt lynum retv)
(setq ff (findfile "c:/ctxt.txt"));_look for text file
(if ff
(progn
(command "undo" "be");_set undo marker
(setq cl (getvar "clayer"));_get current layer
(setq n 1);_while loop killer
(setq ctx '());_empty list
(setq opf (open ff "r"));_if file found open it
(while (= n 1);_loop to read lines of file
  (setq rln (read-line opf))
(if rln (setq ctx(cons rln ctx))(setq n nil));_if line not nil write to list else kill loop
  );_while
(close opf);_close file
(if ctx  ;_if file has info continue 
 (progn
(setq ctx (reverse ctx));_flip list from file
(setq cnt 0);_loop counter
(setq lynum 1);_layer number added to end of layer name
(while (< cnt (length ctx));_loop through list
(setq x (nth cnt ctx));_coordinates
(setq r (nth (1+ cnt) ctx));_redius
(setq retv (crly lynum));_call to layer maker
(setvar "clayer" (nth 0 retv));_set layer to new layer
(setq lynum (nth 1 retv));_layer # counter
(command "_circle" x r);_make circle
(setq cnt (+ cnt 2));_up loop counter by 2
(setq lynum (1+ lynum));_up layer number by 1
);_while
   );_progn  
);_if
(setvar "clayer" cl);_reset back to old layer
(command "undo" "END");_end undo group
  );_progn if txt
  );_if txt
  (princ)
 );_defun

(defun crly (aug1 / lp1 tbs retval)
(command "-purge" "LA" "cir-*" "n");_purge any unused circle layers  
(setq lp1 1);_loop killer
(while (= lp1 1)
(setq tbs (tblsearch "layer" (strcat "cir-" (itoa aug1))));_search for layer
(if tbs  ;_if found  
(setq aug1 (1+ aug1));_up layer # by 1
(progn
(setq lp1 nil);_kill loop if layer not found
(setq retval (strcat "cir-" (itoa aug1)));_new layer name
(command "-layer" "n" retval "");_make new layer
);_progn
);_if
  );_while
(list retval aug1);_return layer name and layer number
);_defun

 

for this I got

 

_APPLOAD

: ccs

: undo

Undo: Mark/Back to mark/BEgin set/End set/Control/Auto/: be

: -purgeerror: rejected function

 

what am I missing?

thanks

Link to comment
Share on other sites

I’m not familiar with IntelliCAD

so it could just be some syntax error for the undo and purge commands.

Looks like it wants the (command “undo” “END”) to read (command “undo” “E”)

Or (command “undo” “End set”)

So just make that change and see what happens.

 

The purge error is a different story. On your IntelliCAD

command line type –purge and see if it is an available command. If not figure out what if any the purge command is in IntelliCAD

 

. For now you can just comment out the purge command line with a semicolon

Placed before the parenthesis like this ;(command “-purge……….

 

If IntelliCAD

has a different purge command we’ll have to replace it for the one I have and make it work.

I just thought it would be nice to purge unused layers incase you deleted the circles.

Link to comment
Share on other sites

Loading C:\Auto Files trial\CirMake.lsp

: STRBRK

 

This is what I got.

I created the text file called ctxt.txt

upload cirmake

 

Did you copy all the code in the frame?

Link to comment
Share on other sites

Yes I did.

all the codes in the frame.

I'll try this again, maybe some formatting issues on the text file?

 

Thanks for the help today guys. I really appreciate it.

Link to comment
Share on other sites

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.


×
×
  • Create New...