View Full Version : Copying a number and increase the value at the same time
lmitsou
2008-07-02, 04:57 PM
Hi all,
I was wondering if there is any way to copy a number (written in AutoCAD using Mtext) and when you duplicate it, it's value will increase by a certain number added to it (number to be defined by the user). So for example, if you write in text editor "1" and then you copy it, it will be copied as 1+ number defined by user. Is there any way of doing this or any routine that can achieve this?
Thank you all in advance.:beer:
jmcshane
2008-07-02, 06:05 PM
Try this :
(defun c:copyinc (/ IncVal TextObj NewPos TextVal NewTextObj)
(vl-load-com)
(setq IncVal (fix (getreal "\nEnter Incremant Value :")))
(setq TextObj
(vlax-ename->vla-object (car (entsel "\nSelect Mtext Object :")))
)
(while
(setq NewPos (getpoint "\nSelect new position : "))
(setq TextVal (atoi (vla-get-textstring TextObj)))
(setq NewTextObj (vla-copy TextObj))
(vla-move NewTextObj
(vla-get-InsertionPoint NewTextObj)
(vlax-3D-Point NewPos)
)
(vla-put-textstring NewTextObj (+ IncVal TextVal))
(setq TextObj NewTextObj)
)
(princ)
)
'gile'
2008-07-02, 06:15 PM
Hi
Here's a 'quickie'
(defun c:inc-copy (/ inc txt elst pt val)
(if (setq inc (getint "\nIncrement value: "))
(if (and
(setq txt (car (entsel "\nSelect a text or mtext: ")))
(member (cdr (assoc 0 (setq elst (entget txt))))
'("MTEXT" "TEXT")
)
(= 'INT (type (setq val (read (cdr (assoc 1 elst))))))
)
(while (setq pt (getpoint "\nInsertion point: "))
(setq val (+ val inc))
(entmake
(subst (cons 10 pt) (assoc 10 elst)
(subst (cons 11 pt) (assoc 11 elst)
(subst (cons 1 (itoa val)) (assoc 1 elst) elst)
)
)
)
)
(princ "\nInvalid entity")
)
)
(princ)
)
jmcshane
2008-07-03, 09:01 AM
(and
(setq txt (car (entsel "\nSelect a text or mtext: ")))
(member (cdr (assoc 0 (setq elst (entget txt))))
'("MTEXT" "TEXT")
)
(= 'INT (type (setq val (read (cdr (assoc 1 elst))))))
)
Every day is a learning day here at AUGI.
Nice one 'gile'. thats the first time I have seen both "type" and "read" used in AutoLisp.
Thanks
CadDog
2008-07-03, 09:37 PM
Can we do this with a block with Text Attributes...???
Here is a old lisp I have which I call Edit Any (text). Dtext, Mtext, dims, Text Attributes...
Is there away to add
((= etype "ATTDEF")
(strcat "Default " (cdr (assoc 3 elist)))
)
((= etype "ATTRIB")
(strcat "Attribute with Tag: " (cdr (assoc 2 elist)))
and have this increment those other types of text also...???
Thanks
;|
This routine will edit the following text type entities:
Text
Attributes
Attribute definitions
Dimension Text
|;
(defun catcherr (s)
(if (/= s "Function cancelled") ; If an error (such as CTRL-C) occurs
(princ (strcat "\nError: " s)) ; while this command is active...
)
(setq p nil) ; Free selection set
(setq *error* olderr) ; Restore old *error* handler
(princ)
)
(defun c:txe(; edit text type entities
/; no formal arguments
ent; entity info returned by nentsel
elist; entity list
etype; entity type
etype2; entity type for dialog box label
oldval; original text value
newval; new text value
elist2; new entity list
get_newval; local function
); end local variable list
;ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ Start local functions ÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
(setq olderr *error*
*error* catcherr)
(defun get_newval(
oldval; old value to be changed
etype; entity type for dialog box label
/; end of formal argument list
); end of local variable list
(setq dcl_id (load_dialog "txe.dcl"))
(if (not (new_dialog "text_edit" dcl_id)) (exit))
(set_tile "text" oldval)
(if etype
(set_tile "box" etype)
)
(action_tile "text" "(setq newval $value)" )
(action_tile "accept" "(done_dialog 1)" )
(if (equal (start_dialog) 1)
nil
(setq newval nil)
)
(unload_dialog dcl_id)
newval
); end get_newval
;ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ Start Main Function ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ
(while (setq ent (nentsel))
(setq
ent2 ent
elist (entget (car ent))
etype (cdr (assoc 0 elist))
); end setq
(if (member etype '("TEXT" "ATTDEF" "ATTRIB" "MTEXT"))
(progn
(setq
etype2 (cond
((= etype "ATTDEF")
(strcat "Default " (cdr (assoc 3 elist)))
)
((= etype "ATTRIB")
(strcat "Attribute with Tag: " (cdr (assoc 2 elist)))
)
((= etype "TEXT")
(if (= 4 (length ent))
(progn
(setq
diment (car (last ent))
dimlist (entget diment)
); end setq
(if (= "DIMENSION" (cdr (assoc 0 dimlist)))
"Dimension Text"
"Nested text"
); end if dimension?
); end progn nested entity
); end progn nested entity
); end cond text
); end cond etype
oldval (cdr (assoc 1 elist))
newval (get_newval oldval etype2)
elist2 (if newval
(subst (cons 1 newval) (assoc 1 elist) elist)
nil
); end if newval returned
); end setq
(if elist2
(progn
(entmod elist2)
(if (= 4 (length ent))
(progn
(setq
diment (car (last ent))
dimlist (entget diment)
); end setq
(if (= "DIMENSION" (cdr (assoc 0 dimlist)))
(progn
(setq dimlist2 (subst (cons 1 newval) (assoc 1 dimlist) dimlist))
(entmod dimlist2)
(entupd diment)
); end progn
); end if dimension
(if (= "INSERT" (cdr (assoc 0 dimlist)))
(entupd diment)
); end if insert
; (setq cmdecho (getvar "cmdecho"))
; (command "dim" "update" diment "" "e")
); end progn ent is nested
(entupd (cdr (assoc -1 elist)))
); end if ent is nested?
); end progn elist2 exists
); end if elist2 exists?
); end progn correct type of entity
(princ "\nNot a text, attdef or attribute entity. ")
); end if
); end while
(princ)
); end c:txe
(princ "\nC:TXE To Edit Any Text\n")
(princ)
CadDog
2008-07-03, 10:53 PM
Here is what I found and where you can see what I did...
Thanks guys and have a great and save 4th...
http://forums.augi.com/showthread.php?p=862624#post862624
lmitsou
2008-07-04, 09:28 AM
Great stuff from everybody guys. Thanks for the fast reply.
:beer::beer::beer::beer:
peter
2008-07-05, 08:28 PM
Here is a routine that use two command reactors.
I made it recognize MTEXT or TEXT on a special layer "INCREMENT" and if they are copied using the COPY command it will increment the INTEGER value of the textstring property.
It can be loaded using the acaddoc.lsp lisp at the opening of the drawing.
Peter
(defun CommandEndedSub (evtCall lstCallback)
(if (= (car lstCallback) "COPY")
(while (setq entLastItem (entnext entLastItem))
(setq objLastItem (vlax-ename->vla-object entLastItem))
(if (and (wcmatch (vla-get-objectname objLastItem) "AcDb*Text")
(= (strcase (vla-get-layer objLastItem)) "INCREMENT")
)
(vla-put-textstring objLastItem (itoa (1+ (atoi (vla-get-textstring objLastItem)))))
)
)
)
(setq entLastItem nil)
)
(defun CommandWillStartSub (evtCall lstCallBack)
(if (= (car lstCALLBACK) "COPY")(setq entLastItem (entlast)))
)
(setq rxnCommandWillStart (vlr-editor-reactor nil '((:vlr-commandwillstart . CommandWillStartSub)))
rxnCommandEnded (vlr-editor-reactor nil '((:vlr-commandended . CommandEndedSub)))
)
(vl-load-com)
lmitsou
2008-07-07, 09:07 AM
Great routine. Thanks! :beer:
CadDog
2008-07-07, 09:18 PM
Here is a routine that use two command reactors.
I made it recognize MTEXT or TEXT on a special layer "INCREMENT" and if they are copied using the COPY command it will increment the INTEGER value of the textstring property.
It can be loaded using the acaddoc.lsp lisp at the opening of the drawing.
Peter
(defun CommandEndedSub (evtCall lstCallback)
(if (= (car lstCallback) "COPY")
(while (setq entLastItem (entnext entLastItem))
(setq objLastItem (vlax-ename->vla-object entLastItem))
(if (and (wcmatch (vla-get-objectname objLastItem) "AcDb*Text")
(= (strcase (vla-get-layer objLastItem)) "INCREMENT")
)
(vla-put-textstring objLastItem (itoa (1+ (atoi (vla-get-textstring objLastItem)))))
)
)
)
(setq entLastItem nil)
)
(defun CommandWillStartSub (evtCall lstCallBack)
(if (= (car lstCALLBACK) "COPY")(setq entLastItem (entlast)))
)
(setq rxnCommandWillStart (vlr-editor-reactor nil '((:vlr-commandwillstart . CommandWillStartSub)))
rxnCommandEnded (vlr-editor-reactor nil '((:vlr-commandended . CommandEndedSub)))
)
(vl-load-com)
I wasn't able to get this one to work...
I loaded it using vlide and lisp load...
I created the layer and add dtext and used copy but nothing happen...
CadDog
2008-07-07, 09:53 PM
OK,
I had a little time this morning and was able to add two and two together...
Because I and many of my users use the keyboard input over pulldowns
I changed to the command name to make it easy to remember and
to type with the left hand...
I hope you guys don't have a problem with me add these together...
Here is the codes which now with one input will handle mtext, text and attributed text.
I hope you like C1
Let me know if you would like me to denote where I change the code.
(defun c:C1 (/ inc txt elst pt val)
(if (setq inc (getint "\nEnter the Increment value you want (1) or (-1): "))
(if (and
(setq txt (car (entsel "\nSelect a text or mtext: ")))
(member (cdr (assoc 0 (setq elst (entget txt))))
'("MTEXT" "TEXT" )
)
(= 'INT (type (setq val (read (cdr (assoc 1 elst))))))
)
(while (setq pt (getpoint "\nInsertion point: "))
(setq val (+ val inc))
(entmake
(subst (cons 10 pt) (assoc 10 elst)
(subst (cons 11 pt) (assoc 11 elst)
(subst (cons 1 (itoa val)) (assoc 1 elst) elst)
)
)
)
)
(C2)
;(princ "\nInvalid entity")
)
)
(princ)
)
;;; --- Increment Number within a block ---
(defun C2 ()
(vl-load-com)
(setq AcadObject (vlax-get-Acad-Object)
ActiveDoc (vla-get-ActiveDocument AcadObject)
util (vla-get-utility ActiveDoc)
) ;_ setq
(setvar "ATTREQ" 0)
(setq TxtPre (strcase (getstring "\nEnter Prefix :"))
TxtNum (getint "\nEnter First number :")
) ;_ setq
(if (<= TxtNum 9)
(setq BlkTxt (strcat TxtPre "" (itoa TxtNum)))
(setq BlkTxt (strcat TxtPre (itoa TxtNum)))
) ;_ if
(setq BlkObj (vlax-ename->vla-object
(car (entsel "\nPlease Select a Block to copy :"))
) ;_ vlax-ename->vla-object
InsPoint (vla-get-insertionpoint BlkObj)
) ;_ setq
(if (= (vla-get-hasattributes BlkObj) :vlax-true)
(vla-put-textstring
(nth 0
(vlax-safearray->list
(variant-value
(vla-getattributes BlkObj)
) ;_ variant-value
) ;_ vlax-safearray->list
) ;_ nth
BlkTxt
) ;_ vla-put-textstring
(alert "Selected Block Does Not Have Any Attributes !")
) ;_ if
(setq PrevEntity t)
(while (and PrevEntity (not (equal PrevEntity (entlast))))
(setq PrevEntity (entlast))
(vl-cmdf "-INSERT" (vla-get-name BlkObj) pause (getvar "dimscale") "" "")
(if (not (equal PrevEntity (entlast)))
(progn
(setq TxtNum (+ TxtNum inc))
;;; (setq TxtNum (1+ TxtNum))
;(if (<= TxtNum 9)
;(setq BlkTxt (strcat TxtPre "0" (itoa TxtNum)))
(setq BlkTxt (strcat TxtPre (itoa TxtNum)))
;) ;_ if
(setq NewBlkObj (vlax-ename->vla-object (entlast)))
(vla-put-textstring
(nth 0
(vlax-safearray->list
(variant-value
(vla-getattributes NewBlkObj)
) ;_ variant-value
) ;_ vlax-safearray->list
) ;_ nth
BlkTxt
) ;_ vla-put-textstring
) ;_ progn
) ;_ if
) ;_ while
(setvar "ATTREQ" 1)
)
My users are liking it and they have only been using it for the past two hours...:)
BTW: I know it isn't the cleaness code...
Thanks guys for the code.
It made it all so easy for me....
**** :( *****
It was find until just now...
User: It doesn't work with text and if it finds .00 anything after the number...
Me: OK, but you asked me have it increment the block key call outs
so what else are you using it for...
User: Well, since it worked with blocks and text numbers.
I tried to us it to add a set number to elevaton (FL 1545.50) and get (TC 1546.00)...
Me: You want the lisp to add half a foot to a number select which also has text?
User: Yes, that would be cool...
@#$@#%%##^&!!!! (I thought)
Me: Let me take another look at it and I'll get back to you...
"What a way to end a great day"
:)
jmcshane
2008-07-08, 11:42 AM
It was find until just now...
User: It doesn't work with text and if it finds .00 anything after the number...
Me: OK, but you asked me have it increment the block key call outs
so what else are you using it for...
User: Well, since it worked with blocks and text numbers.
I tried to us it to add a set number to elevaton (FL 1545.50) and get (TC 1546.00)...
Me: You want the lisp to add half a foot to a number select which also has text?
User: Yes, that would be cool...
@#$@#%%##^&!!!! (I thought)
Me: Let me take another look at it and I'll get back to you...
"What a way to end a great day"
:)
Ha Ha.
No matter how hard you try, its just not good enough for some people :)
I think that subject of incrementing text with both alphabetical and numerical text was discussed in this forum before.
Have a nice one.
CadDog
2008-07-08, 03:24 PM
Ha Ha.
No matter how hard you try, its just not good enough for some people :)
I think that subject of incrementing text with both alphabetical and numerical text was discussed in this forum before.
Have a nice one.
Thanks jmcshane,
I will have a short look around to see if I find that thread
but I told them they could be using their Civil 3D better.
And you got it right...!!!
No matter what you put out there will always be an unhappy user...
:(
peter
2008-07-09, 12:56 PM
I wasn't able to get this one to work...
I loaded it using vlide and lisp load...
I created the layer and add dtext and used copy but nothing happen...
It may be caused by the way you loaded the routine.
I cut and paste the code into the command line. I placed a piece of text and mtext into a drawing and put them on the 'INCREMENT" layer. I copied them (using the COPY command) and both incremented 1 exactly the way they were supposed to. The code works exactly the way it is supposed to.
I tried loading it from the vlide in another drawing and it worked perfectly also.
Check the layer name.
You could try changing this line of the routine
(= (strcase (vla-get-layer objLastItem)) "INCREMENT")
(wcmatch (strcase (vla-get-layer objLastItem)) "INC*")
CadDog
2008-07-09, 03:51 PM
It may be caused by the way you loaded the routine.
I cut and paste the code into the command line. I placed a piece of text and mtext into a drawing and put them on the 'INCREMENT" layer. I copied them (using the COPY command) and both incremented 1 exactly the way they were supposed to. The code works exactly the way it is supposed to.
I tried loading it from the vlide in another drawing and it worked perfectly also.
Check the layer name.
You could try changing this line of the routine
(= (strcase (vla-get-layer objLastItem)) "INCREMENT")
(wcmatch (strcase (vla-get-layer objLastItem)) "INC*")
Nope, that also didn't work...
Here are the steps I have taken:
I copied the code from web page one to 2006 and 2008 using a new file within Vlide.
I then copy the layer name within the code and created a layer using the name in both 2006 & 2008. Next I load the program by using vlide "Load Active Edit Window"
"; 4 forms loaded from #<editor "<Untitled-0> loading...">"
when back to AutoCAD and typed out the number 12 under the layer I just created. I use the command "copy" and just incase I also used the toolbar "copy". In both 2006 & 2008 and using both copy, nothing happen. The command copy did its job and copy but no increment happen. I added the new line of code and still nothing happened.
I do you think I have nothing turn off on my AutoCAD which prevents this code from working...???
peter
2008-07-10, 01:13 PM
Nope, that also didn't work...
Here are the steps I have taken:
I copied the code from web page one to 2006 and 2008 using a new file within Vlide.
I then copy the layer name within the code and created a layer using the name in both 2006 & 2008. Next I load the program by using vlide "Load Active Edit Window"
"; 4 forms loaded from #<editor "<Untitled-0> loading...">"
when back to AutoCAD and typed out the number 12 under the layer I just created. I use the command "copy" and just incase I also used the toolbar "copy". In both 2006 & 2008 and using both copy, nothing happen. The command copy did its job and copy but no increment happen. I added the new line of code and still nothing happened.
I do you think I have nothing turn off on my AutoCAD which prevents this code from working...???
I am puzzled. Try this...
Cut and paste the code into the command line window. The cut all of the pasted text and autocads responses from the text window and post it to the forum.
It should look like this
Command: (defun CommandEndedSub (evtCall lstCallback)
(_> (if (= (car lstCallback) "COPY")
((_> (while (setq entLastItem (entnext entLastItem))
(((_> (setq objLastItem (vlax-ename->vla-object entLastItem))
(((_> (if (and (wcmatch (vla-get-objectname objLastItem) "AcDb*Text")
(((((_> (= (strcase (vla-get-layer objLastItem)) "INCREMENT")
(((((_>
(((((_> )
((((_> (vla-put-textstring objLastItem (itoa (1+ (atoi (vla-get-textstring
objLastItem)))))
((((_> )
(((_> )
((_> )
(_> (setq entLastItem nil)
(_> )
COMMANDENDEDSUB
Command:
D dist Specify first point: nil
Specify first point: (defun CommandWillStartSub (evtCall lstCallBack)
(_> (if (= (car lstCALLBACK) "COPY")(setq entLastItem (entlast)))
(_> )
COMMANDWILLSTARTSUB
Specify first point:
Command: (setq rxnCommandWillStart (vlr-editor-reactor nil
'((:vlr-commandwillstart . CommandWillStartSub)))
(_> rxnCommandEnded (vlr-editor-reactor nil '((:vlr-commandended
. CommandEndedSub)))
(_> )
#<VLR-Editor-Reactor>
Command: (vl-load-com)
I want to make sure the #<VLR-Editor-Reactor> response appears.
Create the INCREMENT layer and try the copy again.
CadDog
2008-07-10, 09:46 PM
I am puzzled. Try this...
Cut and paste the code into the command line window. The cut all of the pasted text and autocads responses from the text window and post it to the forum.
" CODE WENT HERE "
I want to make sure the #<VLR-Editor-Reactor> response appears.
Create the INCREMENT layer and try the copy again.
I open 2006 and did as you asked and here is what I got:
Command: *Cancel*
Command: (defun CommandEndedSub (evtCall lstCallback)
(_> (if (= (car lstCallback) "COPY")
((_> (while (setq entLastItem (entnext entLastItem))
(((_> (setq objLastItem (vlax-ename->vla-object entLastItem))
(((_> (if (and (wcmatch (vla-get-objectname objLastItem) "AcDb*Text")
(((((_> (= (strcase (vla-get-layer objLastItem)) "INCREMENT")
(((((_>
(((((_> )
((((_> (vla-put-textstring objLastItem (itoa (1+ (atoi (vla-get-textstring
objLastItem)))))
((((_> )
(((_> )
((_> )
(_> (setq entLastItem nil)
(_> )
COMMANDENDEDSUB
Command:
COPY
Select objects: (defun CommandWillStartSub (evtCall lstCallBack)
(_> (if (= (car lstCALLBACK) "COPY")(setq entLastItem (entlast)))
(_> )
COMMANDWILLSTARTSUB
Select objects:
Command: (setq rxnCommandWillStart (vlr-editor-reactor nil
'((:vlr-commandwillstart . CommandWillStartSub)))
(_> rxnCommandEnded (vlr-editor-reactor nil '((:vlr-commandended
. CommandEndedSub)))
(_> )
#<VLR-Editor-Reactor>
Command: (vl-load-com)
Command: COPY
Select objects: 1 found
Select objects:
Specify base point or [Displacement] <Displacement>: Specify second point or
<use first point as displacement>:
Specify second point or [Exit/Undo] <Exit>:
Specify second point or [Exit/Undo] <Exit>: *Cancel*
Command:
Automatic save to C:\Temp\SaveDwg\2006\Drawing1_1_1_0633.sv$ ...
And again, COPY command worked but not the increment command...
peter
2008-07-12, 01:46 PM
And again, COPY command worked but not the increment command...
I created this test drawing.
Open it and Cut and past the code into command line. Then copy all of the numbers (text and mtext) and tell me what it does.
I know the routine works for me, It is probably just something simple...
Peter
CadDog
2008-07-14, 02:21 AM
PETER...???
I only have AutoCAD 2002 at home and I couldn't wait until tomorrow to check this out...
I open 2002, created the layer "INCREMENT", copied your code into vlisp and loaded it from there...
Next I typed a numer "12" using dtext and it WORKED...!!!
Here is what it looks like from the command line:
Command: (defun CommandEndedSub (evtCall lstCallback)
(_> (if (= (car lstCallback) "COPY")
((_> (while (setq entLastItem (entnext entLastItem))
(((_> (setq objLastItem (vlax-ename->vla-object entLastItem))
(((_> (if (and (wcmatch (vla-get-objectname objLastItem) "AcDb*Text")
(((((_> (= (strcase (vla-get-layer objLastItem)) "INCREMENT")
(((((_>
(((((_> )
((((_> (vla-put-textstring objLastItem (itoa (1+ (atoi (vla-get-textstring
objLastItem)))))
((((_> )
(((_> )
((_> )
(_> (setq entLastItem nil)
(_> )
COMMANDENDEDSUB
Command:
'VLIDE
Command:
Command: (defun CommandWillStartSub (evtCall lstCallBack)
(_> (if (= (car lstCALLBACK) "COPY")(setq entLastItem (entlast)))
(_> )
COMMANDWILLSTARTSUB
Command:
'VLIDE
Command:
Command: (setq rxnCommandWillStart (vlr-editor-reactor nil
'((:vlr-commandwillstart . CommandWillStartSub)))
(_> rxnCommandEnded (vlr-editor-reactor nil '((:vlr-commandended
. CommandEndedSub)))
(_> )
#<VLR-Editor-Reactor>
Command: (vl-load-com)
Command:
'VLIDE
Command:
Command: copy
Select objects: 1 found
Select objects: Specify base point or displacement, or [Multiple]: Specify
second point of displacement or <use first point as displacement>: ; error: bad
argument type: lentityp nil
; error: bad argument type: lentityp nil
; error: bad argument type: lentityp nil
There maybe a var which I don't have set at home but which I may have set at work and AutoCAD 2006 and 2008...???
CadDog
2008-07-14, 03:48 PM
Good Morning all and Peter...
I did as you asked and it also worked this morning using your drawing...
Using your numbers copied one then all the numbers you had on your drawing and they all incremented one number higher.
??? :?
What the @#$#...???
However, when I create a new drawing using our acad.dwt
running the lisp doesn't work...
What's the trick...???
[QUOTE=CadDog;863362]OK,
I had a little time this morning and was able to add two and two together...
SNIP
BTW: I know it isn't the cleaness code...
Dude, You rock. This is a cool routine.
Thanks
Jim
CadDog
2008-07-20, 06:54 PM
[QUOTE=CadDog;863362]OK,
I had a little time this morning and was able to add two and two together...
SNIP
BTW: I know it isn't the cleaness code...
Dude, You rock. This is a cool routine.
Thanks
Jim
Thanks Jim but I didn't write the code I just adjusted it for me...
I'm glade you find it helpful and
you are welcome from all of us... :)
lmitsou
2008-07-21, 09:53 AM
...I think that subject of incrementing text with both alphabetical and numerical text was discussed in this forum before...
Good morning all,
Does anyone know where I can find this thread? I had a look around but I didn't find anything. I have the same issue as Jesse. My users want this lisp to work with alphabetical and numerical text!
:beer::beer::beer:
Good morning all,
Does anyone know where I can find this thread? I had a look around but I didn't find anything. I have the same issue as Jesse. My users want this lisp to work with alphabetical and numerical text!
:beer::beer::beer:
Try this thread, "Does anybody have a LISP that will increment a letter? (http://forums.augi.com/showthread.php?t=35876&highlight=increment+text)."
'gile'
2008-07-21, 11:35 PM
Hi,
Here's one which increment numeric alphabetic or alphanumeric values at the end of a string according to the flag value.
;; INCSUFF -Gilles Chanteau- 2008/01/15
;; Adds the specified increment to a string suffix.
;; Is considered as suffix, all [0-9], [A-Z] and [a-z] characters from
;; the end of the string according to flag value.
;;
;; Arguments
;; str : a string
;; inc : a positive integer
;; flag : an integer, the sum of following binary codes
;; 1 for numbers [0-9]
;; 2 for uppercase [A-Z]
;; 4 for lowercase [a-z]
;;
;; Return
;; The string with incremented suffix (or nil if none valid suffix)
;;
;; Examples :
;; (incsuff "N° 002" 12 1) = "N° 014"
;; (incsuff "Drawing_A" 1 1) = "Drawing_B"
;; (incsuff "test_ZZ9" 1 3) = "test_AAA0"
;; (incsuff "test_ZZ9" 1 1) = "test_ZZ10"
;; (incsuff "12-" 1 nil) = nil
;;
;; Update (13/02/08) : binary codes
(defun incsuff (str inc flag / lst crt pas ind dep quo ret)
(setq lst (reverse (vl-string->list str)))
(while
(and
(setq crt (car lst))
(cond
((< 47 crt 58)
(setq pas 10
ind 48
)
)
((and flag (< 64 crt 91))
(setq pas 26
ind 65
)
)
((and flag (< 96 crt 123))
(setq pas 26
ind 97
)
)
((< 0 quo)
(setq crt (if (= 10 pas)
ind
(1- ind)
)
lst (cons (car lst) lst)
)
)
)
)
(setq dep (- crt ind)
quo (/ (+ dep inc) pas)
ret (cons (+ ind (rem (+ dep inc) pas)) ret)
)
(if (zerop quo)
(setq ret (append (reverse (cdr lst)) ret)
lst nil
)
(if (cdr lst)
(setq lst (cdr lst)
inc quo
)
(setq lst (list ind)
inc (if (= 10 pas)
quo
(1- quo)
)
)
)
)
)
(if ret
(vl-list->string ret)
)
)
CAB2k
2008-07-22, 04:44 AM
One more to try:
;;=======================================
;; Version 2.6 CAB 03/21/08
;;; TxtInc.lsp by Charles Alan Butler
;;; Copyright 2004-2008
;;; by Precision Drafting & Design All Rights Reserved.
;;; Contact at CAB at TheSwamp.org
;;;
;;; Version 1.0 Beta November 13, 2003
;;; Version 1.1 Beta November 14, 2003
;;; Added support for %% codes & Unicode \U+nnnn
;;; Version 1.2 Beta November 15, 2003
;;; Cleaned up code, error check for MText>250 char
;;; Version 2.0 Beta January 01, 2004
;;; Added support for "ADD" mode
;;; Added limited support for negative increment values
;;; All possibilities were not tested
;;; Version 2.1 September 05, 2004
;;; Added selection set option to Add Mode so you can
;;; select a group of objects to be updated
;;; Version 2.2 September 10, 2004
;;; Added 'Copy Mode' user entery of text.
;;; Version 2.3 January 7, 2005
;;; Added recoginition of feet & inches format 10'-5"
;;; Version 2.3 June 13, 2005 - Bug Fix in Copy mode
;;; Version 2.4 Nov 05, 2005 - Realy Fixed the Bug in Copy mode
;;; when ENTER was pressed another copy was added to dwg
;;; Version 2.5 May 05, 2007 - REPLACE mode is working
;;; Version 2.6 Mar 21, 2008 - REPLACE mode bug fix for Inc Existing numbers
;;;
;;; DESCRIPTION
;;; Adds user increment to the first integer found in a text string
;;; works with Dtext and Mtext (limited to 250 character size)
;;; Ignores decimal points, spaces, and slashes i.e. for fractions
;;;
;;; The following examples assume an increment value of one
;;; Copy Mode will produce an incremented copy to be positioned by the user
;;; 5ABC -> 6ABC 7ABC 8ABC
;;; Add Mode will update the number in selected text by the increment amount.
;;; You may pick one at a time or a group of text objects.
;;; 5ABC -> 6ABC or [1ABC 2ABC 3ABC] -> [2ABC 3ABC 4ABC]
;;; [1ABC 3ABC 5ABC] -> [2ABC 4ABC 6ABC]
;;; Replace Mode is under development, intended to replace the existing number
;;; in text.
;;; Start value >0, replace the text with the start value, Start = 1
;;; 6ABC -> 1ABC 4ABC -> 2ABC 1ABC -> 3ABC
;;; Start value 0, use the number found in the first text as the start value
;;; 6ABC -> 6ABC 4ABC -> 7ABC 1ABC -> 8ABC
;;; Example of use, Place a text '1' at the first tread on stairs, use the
;;; array command to populate the remaining treads, then use the Replace
;;; mode to change the '1's to 1 2 3 4 etc.
;;;
;;; Limitations
;;; In mtext, if there is a change in the formatting within a number such as
;;; number 123456 with a color change ie 123 in red and 456 in ByLayer the
;;; 456 will be ignored and only the 123 altered, the actual string looks
;;; something like this "{\\C1;123}456\\PNew Line"
;;; Also cammas break the number into two items 123,456 will be treated as
;;; 123 and the 456 ignored
;;;
;;; Negative numbers in text are processed only when the increment
;;; value is negative and you approve it at a prompt
;;; If No
;;; "A-1" -2 returns "A-3", "A1" -2 returns "A-1"
;;; If Yes return numbers will not go below zero
;;; "A-5" -2 returns "A-3", "A1" -2 returns "A0"
;;; "A-1" -2 returns "A-0",
;;;
;;; No support for reals or fractions
;;;
;;; Command Line Usage
;;; Command: TxtInc
;;; Command: Select Mode: [Copy & Increment] or [Add to existing text]
;;; or [Replace existing text] <Copy>
;;; Command: Enter increment value: <1>
;;; Command: Select Text to Copy & Increment:
;;; or
;;; Command: Select Text to Increment:
;;;
;;; THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED
;;; WARRANTY. ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR
;;; PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED.
;;; ;
;;; You are hereby granted permission to use, copy and modify this ;
;;; software without charge, provided you do so exclusively for ;
;;; your own use or for use by others in your organization in the ;
;;; performance of their normal duties, and provided further that ;
;;; the above copyright notice appears in all copies and both that ;
;;; copyright notice and the limited warranty and restricted rights ;
;;; notice above appear in all supporting documentation. ;
peter
2008-07-22, 03:30 PM
Good Morning all and Peter...
I did as you asked and it also worked this morning using your drawing...
Using your numbers copied one then all the numbers you had on your drawing and they all incremented one number higher.
??? :?
What the @#$#...???
However, when I create a new drawing using our acad.dwt
running the lisp doesn't work...
What's the trick...???
Sorry I was on holiday for the last week. I am not sure of the problem. Making sure of the layer name is spelled correctly. Make sure the routine is loaded correctly. How about you send me the drawing file that didn't work "offline" peter@cordecksales.com
I will see if I can figure it out for you.
Peter
CadDog
2008-07-22, 11:58 PM
Peter,
Don't kill yourself, I have one with the users like and
where they select the amont of increment on the screen.
Like I said, it maybe something I set in my AcadDoc.lsp
here at work which isn't set at home in my AutoCAD 2002.
I feel that it isn't my drawing but my AcadDoc.lsp
which maybe cause this lisp not to work.
Thanks for trying and helping.
Jesse (aka CadDog)
vBulletin® v3.6.7, Copyright ©2000-2010, Jelsoft Enterprises Ltd.