You could use the "tcircle" (Express Tools) command to put "frames" (rectangles) around multiple text objects.
Registered forum members do not see this ad.
Hello. I wonder if anybody can help me. I do lot of action where is some number (example 100). Then I need copy this number and put there one more (101) and next 102 and so on.
I found one LISP code what work good, but only problem is that I need also frames around that number. So I need own block and inside that increment number. Thank for you helping.




You could use the "tcircle" (Express Tools) command to put "frames" (rectangles) around multiple text objects.
Thanks, but that it`s not now same what I need to use. I mean like this program http://www.eng-tips.com/viewthread.c...=138436&page=1 (<--first answer) with my own frames (=program get that frame to my choosing block files). My frame is not like circle or rectangular that`s why I must use my own frame...
Can you attach a sample DWG with your text & frame in it?
How about some pseudo code
if no block in dwg
make block, get user input for starting number
else get attributes, next number is highest number +1
endif
get user point to insert the block
insert the block & update the attribute
repeat insert until user quits
Last edited by CAB; 11th Jan 2007 at 10:09 pm.
Here is my old one, hope this will be
work for you too
~'J'~Code:(defun C:INN (/ gap hg inum ip p1 p2 tb wd) (setq inum (getint "\n\tEnter a number to start with: ")) (while (setq ip (getpoint "\n\tSpecify text insertion point (Enter to stop): ")) ; entmake text (entmake (list '(0 . "TEXT") '(100 . "AcDbEntity") '(100 . "AcDbText") (cons 1 (itoa inum));string (cons 7 "Standard");style (cons 8 "0");layer (cons 62 256);color (cons 10 ip);insertion point (cons 11 ip);alignment point (cons 40 (getvar "dimtxt"));text height - change by suit (cons 41 1.0);text width (cons 50 0.0);1.5708 - vertical, 0.0 - horizontal (cons 51 0.0);oblique angle '(71 . 0);alignment '(72 . 1);alignment '(73 . 2);alignment ) ) (setq tb (textbox (entget (entlast)))) (setq gap (/ (getvar "dimtxt") 4) p1 (car tb) p2 (cadr tb) hg (abs (- (cadr p1)(cadr p2))) wd (abs (- (car p1)(car p2))) p1 (list (- (car ip) (/ wd 2) gap)(- (cadr ip) (/ hg 2) gap)) p2 (list (+ (car ip) (/ wd 2) gap)(+ (cadr ip) (/ hg 2) gap)) ) ; entmake frame (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 4);number of vertices '(70 . 1);closed flag (cons 8 "0");layer (cons 62 2);color (256 - ByLayer) (cons 10 p1) (list 10 (car p2) (cadr p1)) (cons 10 p2) (list 10 (car p1) (cadr p2)) (cons 43 0.0);polyline width ) ) (setq inum (1+ inum)) ) (prin1) ) (prompt "\nType INN to execute ...") (princ)


>janisa I use this {Smirnoff} rountines
Num - Insert text with increment value
Renum - Renumbering text in DIMENSION, TEXT, MTEXT, ATTRIB, ATTDEF, ACAD_TABLE
TTC - Text to Text copy. Copy text from DIMENSION, TEXT, MTEXT, ATTRIB, ATTDEF, ACAD_TABLE to one
[/code]
The command RENUM can change numbering in DIMENSION, TEXT, MTEXT, ATTRIB in blocks, ATTDEF, ACAD_TABLE.
Choosing the block, it is necessary to specify on attribute.
I alterate c:num for numbering by blocks with single attribute.
Without prefix and suffix:
And with prefix and suffix:Code:(defun c:atnum (/ oldStart oldEcho oldSize oldBlock temBl *error*) (defun *error* (msg) (setvar "CMDECHO" oldEcho) (princ) ); end *error* (if(not atnum:Size)(setq atnum:Size 1.0)) (if(not atnum:Num)(setq atnum:Num 1)) (setq oldStart atnum:Num oldSize atnum:Size oldEcho(getvar "CMDECHO") ); end setq (setvar "CMDECHO" 0) (setq atnum:Num (getint (strcat "\nSpecify start number <"(itoa atnum:Num)">: "))) (if(null atnum:Num)(setq atnum:Num oldStart)) (setq atnum:Size (getreal (strcat "\nSpecify block scale <"(rtos atnum:Size)">: "))) (if(null atnum:Size)(setq atnum:Size oldSize)) (if atnum:Block(setq oldBlock atnum:Block)) (setq temBl (entsel(strcat "\nSelect block <" (if atnum:Block atnum:Block "not difined") "> > "))); end setq (cond ((and atnum:Block(not temBl)(tblsearch "BLOCK" atnum:Block)) (setq atnum:Block oldBlock) ); end condition #1 ((= 1(cdr(assoc 66(entget(car temBl))))) (setq atnum:Block(cdr(assoc 2(entget(car temBl))))) ); end condition #2 (t (princ "\nBlock not contains attribute! ") (setq atnum:Block nil) ); end condition #3 ); end cond (if atnum:Block (progn (princ "\n>>> Pick insertion point or press Esc to quit <<<\n ") (while T (command "-insert" atnum:Block "_s" atnum:Size pause "0"(itoa atnum:Num)) (setq atnum:Num(1+ atnum:Num)) ); end while ); end progn ); end if (princ) ); end of c:atnum
Code:(defun c:apnum (/ oldStart oldPref oldSuf oldEcho oldSize oldBlock temBl *error*) (defun *error* (msg) (setvar "CMDECHO" oldEcho) (princ) ); end *error* (if(not apnum:Size)(setq apnum:Size 1.0)) (if(not apnum:Num)(setq apnum:Num 1)) (if(not apnum:Pref)(setq apnum:Pref "")) (if(not apnum:Suf)(setq apnum:Suf "")) (setq oldStart apnum:Num oldSize apnum:Size oldPref apnum:Pref oldSuf apnum:Suf oldEcho(getvar "CMDECHO") ); end setq (setvar "CMDECHO" 0) (setq apnum:Pref (getstring T (strcat "\nType prefix: <"apnum:Pref">: "))) (if(= "" apnum:Pref)(setq apnum:Pref oldPref)) (if(= " " apnum:Pref)(setq apnum:Pref "")) (setq apnum:Suf (getstring T (strcat "\nType suffix: <"apnum:Suf">: "))) (if(= "" apnum:Suf)(setq apnum:Suf oldSuf)) (if(= " " apnum:Suf)(setq apnum:Suf "")) (setq apnum:Num (getint (strcat "\nSpecify start number <"(itoa apnum:Num)">: "))) (if(null apnum:Num)(setq apnum:Num oldStart)) (setq apnum:Size (getreal (strcat "\nSpecify block scale <"(rtos apnum:Size)">: "))) (if(null apnum:Size)(setq apnum:Size oldSize)) (if apnum:Block(setq oldBlock apnum:Block)) (setq temBl (entsel(strcat "\nSelect block <" (if apnum:Block apnum:Block "not difined") "> > "))); end setq (cond ((and apnum:Block(not temBl)(tblsearch "BLOCK" apnum:Block)) (setq apnum:Block oldBlock) ); end condition #1 ((= 1(cdr(assoc 66(entget(car temBl))))) (setq apnum:Block(cdr(assoc 2(entget(car temBl))))) ); end condition #2 (t (princ "\nBlock not contains attribute! ") (setq apnum:Block nil) ); end condition #3 ); end cond (if apnum:Block (progn (princ "\n>>> Pick insertion point or press Esc to quit <<<\n ") (while T (command "-insert" apnum:Block "_s" apnum:Size pause "0" (strcat apnum:Pref(itoa apnum:Num)apnum:Suf)); end command (setq apnum:Num (1+ apnum:Num)) ); end while ); end progn ); end if (princ) ); end of c:apnum
Thank you all very much for help. Now it`s work fine. Only one thing to ask. Is there any way get first number 0. Example if my number is 0505 and next 0506, program take this first 0 off. Like 505 and 506... but thanks anyway a lot of
Edit. I tried this prefix and that of course fix my problem...
Registered forum members do not see this ad.
Hope this will be fix your problem with zeroes
in front of number and prefixes
Feel free to change to your suit
Btw, if you will jump say from "99" to "100"
how will be changes the size of your framed blocks?
My code do it dynamically without any blocks
~'J'~Code:(defun C:INN (/ ch gap hg init initstr ip p1 p2 pref tb wd) (setq bef (getstring "\n\tEnter prefix or press Enter w/o it: ")) (setq initstr (getstring "\nEnter initial number or press Enter to default <0001> : ")) (if (eq "" initstr)(setq initstr "0001")) (setq pref "") (setq init (atoi initstr)) (if (eq "0" (substr initstr 1 1)) (progn (while (eq "0" (setq ch (substr initstr 1 1))) (setq pref (strcat pref ch)) (setq initstr (substr initstr 2))))) (while (setq ip (getpoint "\n\tSpecify text insertion point (Enter to stop): ")) ; entmake text (entmake (list '(0 . "TEXT") '(100 . "AcDbEntity") '(100 . "AcDbText") (cons 1 (strcat bef pref (itoa init)));string (cons 7 "Standard");style (cons 8 "0");layer (cons 62 256);color (cons 10 ip);insertion point (cons 11 ip);alignment point (cons 40 (getvar "dimtxt"));text height - change by suit (cons 41 1.0);text width (cons 50 0.0);1.5708 - vertical, 0.0 - horizontal (cons 51 0.0);oblique angle '(71 . 0);alignment '(72 . 1);alignment '(73 . 2);alignment ) ) (setq tb (textbox (entget (entlast)))) (setq gap (/ (getvar "dimtxt") 4) p1 (car tb) p2 (cadr tb) hg (abs (- (cadr p1)(cadr p2))) wd (abs (- (car p1)(car p2))) p1 (list (- (car ip) (/ wd 2) gap)(- (cadr ip) (/ hg 2) gap)) p2 (list (+ (car ip) (/ wd 2) gap)(+ (cadr ip) (/ hg 2) gap)) ) ; entmake frame (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 4);number of vertices '(70 . 1);closed flag (cons 8 "0");layer (cons 62 2);color (256 - ByLayer) (cons 10 p1) (list 10 (car p2) (cadr p1)) (cons 10 p2) (list 10 (car p1) (cadr p2)) (cons 43 0.0);polyline width ) ) (setq init (1+ init)) ) (prin1) ) (prompt "\nType INN to execute ...") (princ)
Bookmarks