Looking for lisp

I'm looking for a LISP routine that will increment integers with a prefix.
For example R1 R2 R3
I'm hoping it would edit existing text instead of creating it.
Does anyone know of one?
I'm using CAD 2004 with Win XP

 

Do you have the intergers and just want to add the "R"? I have one that can do that, but if you want to change existing text, say you have a "5" and you want to change that to "R1" then that is something else. I'm not sure what you're looking for, could you explain a little more.

Tim

 

Say I have a list of relays labeled R1 through R30 and I need it
to say R31 through R60.
I'm hoping to just select the text and have it increment the integer by 1.

 

If you have express tools try automatic text numbering

 

Well Express is great except it seems to put an unwanted space between the prefix and the integer

 

You can try one of these. For text type "addtext" for attributes type "addatt". It will add a certain amout to the first no alpha character in text or an attribute. It should work for what you described.

Tim

(defun c:AddText (/ txt1 txt2 cnt1 ent1 pec1 ss)

(command "_.undo" "_end")
(command "_.undo" "_group")
(vl-load-com)
(setq txt1 (getreal "\nEnter value to increase by (if decreasing, add a minus sign before). "))
(setq cnt1 0)
(if txt1
(progn
(if (not *pec1)
(setq *pec1 3)
)
(setq pec1 (getreal (strcat "\nHow many decimal places [" (itoa *pec1) "]? ")))
(if pec1
(setq *pec1 (fix pec1))
)
(setq ss (ssget '((0 . "TEXT"))))
(while (/= cnt1 (sslength ss))
(setq ent1 (MakeX (ssname ss cnt1)))
(setq txt2 (GetX ent1 'TextString))
(PutX ent1 'Textstring (AddStrNReal txt2 txt1 2 *pec1))
(setq cnt1 (1+ cnt1))
)
)
)
(prompt "\n May get rounded-off if new decimal is less then existing decimal places!!")
(command "_.undo" "_end")
(princ)
)

;============================================================================================

(defun c:AddAtt (/ blkname tagname tagtype blkent)

(command "_.undo" "_end")
(command "_.undo" "_group")
(vl-load-com)
(initget "N")
(setq blkname (entsel "\nSelect block or [N to type in name]: "))
(if (= blkname "N")
(setq blkname (getstring T"\nEnter name of block: "))
(progn
(redraw (setq blkent (car blkname)) 3)
(setq blkname (value 2 (entget (car blkname))))
)
)
(if (tblsearch "block" blkname)
(while (/= tagtype "ATTRIB")
(initget "T")
(setq tagname (nentsel "\nSelect attribute or [T to type in tag]: "))
(if (= tagname "T")
(setq tagname (getstring "\nEnter tag name: ")
tagtype "ATTRIB"
)
(setq tagtype (value 0 (entget (car tagname)))
tagname (value 2 (entget (car tagname)))
)
)
)
(prompt "\n No block by that name exist in drawing.")
)
(redraw blkent 4)
(AttAdd blkname tagname)
(command "_.undo" "_end")
(princ)
)

;=============================================================================================

(defun AttAdd (blkname attname / txt1 txt2 cnt1 ent1 pec1 ss)

(command "_.undo" "_end")
(command "_.undo" "_group")
(vl-load-com)
(setq txt1 (getreal "\nEnter value to increase by (if decreasing, add a minus sign before). "))
(setq cnt1 0)
(if txt1
(progn
(if (not *pec1)
(setq *pec1 3)
)
(setq pec1 (getreal (strcat "\nHow many decimal places [" (itoa *pec1) "]? ")))
(if pec1
(setq *pec1 (fix pec1))
)
(setq ss (ssget (list (cons 2 blkname)(cons 66 1))))
(while (/= cnt1 (sslength ss))
(setq ent1 (MakeX (ssname ss cnt1)))
(setq alist (vlax-invoke ent1 'GetAttributes))
(foreach item alist
(if (= (strcase (getx item 'TagString)) (strcase attname))
(PutX item 'Textstring (AddStrNReal (getx item 'TextString) txt1 2 *pec1))
)
)
(setq cnt1 (1+ cnt1))
)
)
)
(prompt "\n May get rounded-off if new decimal is less then existing decimal places!!")
(command "_.undo" "_end")
(princ)
)
;=============================================================================================

(defun AddStrNReal (StrValue RealNum StrType DecPlace / cnt1 cnt2 txt4 txt5 txt6 txt7 com1 op1 dec1)

(setq cnt1 0
cnt2 0
)
(if (and (>= (ascii (substr StrValue 1 1)) 65) (/= (ascii (substr StrValue 1 1)) 32))
(while (>= (ascii (substr StrValue 1 1)) 65)
(if txt4
(setq txt4 (strcat txt4 (substr StrValue 1 1)))
(setq txt4 (substr StrValue 1 1))
)
(setq StrValue (substr StrValue 2 (strlen StrValue)))
)
)
(while (= (substr StrValue 1 1) " ")
(if txt4
(setq txt4 (strcat txt4 (substr StrValue 1 1)))
(setq txt4 (substr StrValue 1 1))
)
(setq StrValue (substr StrValue 2 (strlen StrValue)))
)
(if (< (ascii (substr StrValue 1 1)) 65)
(while (and (<= (ascii (substr StrValue 1 1)) 65) (/= (ascii (substr StrValue 1 1)) 0) (/= (ascii (substr StrValue 1 1)) 32))
(if (= (substr StrValue 1 1) ",")
(if (and (<= (ascii (substr StrValue 2 1)) 57) (>= (ascii (substr StrValue 2 1)) 48))
(setq StrValue (substr StrValue 2 (strlen StrValue)))
(setq com1 "yes")
)
)
(if (and txt5 (not com1))
(setq txt5 (strcat txt5 (substr StrValue 1 1)))
(setq txt5 (substr StrValue 1 1))
)
(setq StrValue (substr StrValue 2 (strlen StrValue)))
)
)
(setq txt5 (atof txt5))
(setq txt6 (rtos (+ txt5 RealNum) StrType DecPlace))
(if (> (atoi txt6) 999)
(progn
(initget "Y N")
(setq op1 (getkword "\nWould you like to add comma(s) [Y,<N>]? "))
(if (= op1 "Y")
(progn
(setq txt7 txt6)
(while (and (/= dec1 ".") (<= (strlen txt6) 0))
(setq dec1 (substr txt6 1 1))
(setq cnt1 (1+ cnt1))
(setq txt6 (substr txt6 2 (strlen txt6)))
)
(if (= dec1 ".")
(progn
(setq txt6 (substr txt6 1 (- (strlen txt6) 1)))
(setq txt7 (substr txt7 (strlen txt6) (strlen txt7)))
)
)
(while (>= (strlen txt6) (+ cnt2 4))
(setq txt6 (strcat (substr txt6 1 (- (strlen txt6) (+ 3 cnt2))) "," (substr txt6 (- (strlen txt6) (+ 2 cnt2)) (strlen txt6))))
(setq cnt2 (+ cnt2 4))
)
(if (= dec1 ".")
(setq txt6 (strcat txt6 txt7))
)
)
)
)
)
(setq txt7
(if txt4
(strcat txt4 txt6 StrValue)
(strcat txt6 StrValue)
)
)

)

 

Thanks but I cant seem to get addtext to work.
It loads and starts ok, but it ends saying MakeX.
The last one (AddStrNReal) doesn't seem to load at all.
Is this the correct name for this lisp.
thanks for your efforts.

 

Sorry about that, I forgot to give you the other sub-programs. Here they are. If it doesn't work still let me know because it works fine on my comp.

Tim

(defun MakeX (entname)
(vlax-ename->vla-object entname)
)

(defun GetX (object prop)
(if (vlax-property-available-p object prop)
(vlax-get object prop)
)
)

(defun PutX (object prop val)
(if (vlax-property-available-p object prop T)
(vlax-put object prop val)
)
)

 

Hi Willey, what do you mean and what purpose it
(command "_.undo" "_end")
(command "_.undo" "_group")

are. If it doesn't work still let me know because it works fine on my comp.

 

(command "_.undo" "_group") This will start an undo for your whole routine. It will last until you do a (command "_.undo" "_end"). If someone has done and undo group without you knowing, then if you don't end it first you will undo that to if you type undo after your code.

Example:
You zoom window, run a code (without the undo's), after the code you type "u" for undo. That "u" will undo everything in your code (unless you have a command with in your code) plus the zoom.
Now if you put the (command "_.undo" "_group") at the begining and a (command "_.undo" "_end") at the end, after you run you code and hit an "u", it will only undo your code.

I have learned here that you want to put an (command "_.undo" "_end") at the beginning of your code to make sure that your (command "_.undo" "_group") is a new group.

Hope that is clear, if not post what wasn't clear.
Tim

 

Hi Willey,thanks for your reply,I understand after your give advice.

routine. It will last until you do a (command "_.undo" "_end"). If someone
has done and undo group without you knowing, then if you don't end it first
you will undo that to if you type undo after your code.

"u" for undo. That "u" will undo everything in your code (unless you have a
command with in your code) plus the zoom.

(command "_.undo" "_end") at the end, after you run you code and hit an "u",
it will only undo your code.

the beginning of your code to make sure that your (command "_.undo"
"_group") is a new group.