Alerie Posted September 22, 2016 Share Posted September 22, 2016 Hi, I need a script to add a value "n" at last number in a text string. If possible that also work on block and multiselection. Example: TT-1530 -> TT-1890 10-TT-1530 -> 10-TT-1890 Can you help me please ? I dont know how edit or write script, but I found two script on internet First Script: This script add the value at the first number of string and not at last and dont work on block. (defun DXF (code elist) ; finds the association pair, strips 1st element (cdr (assoc code elist)) ) (princ) (defun c:CEL (/ me ce hl rm bm bmoff dprec i j en ed ety lay ss len etxt wtxt elen pretxt txt posttxt ex ey ez ntxt nz old new nxyz mod) (prompt "\n\nChange Bench Mark for Annotation Text v2.2 2/10/93") ; (setq me (getvar "menuecho")) (setvar "menuecho" 0) (setq ce (getvar "cmdecho")) (setvar "cmdecho" 0) (setq rm (getvar "regenmode")) (setvar "regenmode" 0) (setq bm (getvar "blipmode")) (setvar "blipmode" 0) ; Prompt for bench mark offset (print) (initget 1) (setq bmoff (getreal "\nEnter value for bench mark offset, <0> to exit? ")) (if (/= bmoff 0) (progn (initget 1) (setq dprec (getint "Enter decimal precision for annotation? ")) (prompt "\n\nBench Mark Offset value: ")(princ bmoff) (prompt "\nDecimal precision on annotation: ")(princ dprec) ; Locate text to change and select all text on that layer ; prompt user to pick text entity ; Create selection set of all annotation text entities (setq ss (ssget (list (cons 0 "TEXT")))) ; Process text and modify based on bench mark offset (setq i 0 mod 0) (setq len (sslength ss)) (while (< i len) (setq en (ssname ss i) ed (entget en) txt "" pretxt "" posttxt "" noproc 0) (setq etxt (dxf 1 ed)) (setq wtxt etxt) (setq ex (car (dxf 10 ed))) (setq ey (cadr (dxf 10 ed))) (setq ez (caddr (dxf 10 ed))) (setq elen (strlen etxt)) (setq j 1) ; Locate PRE-text (if (not (member (substr etxt j 1) '("1" "2" "3" "4" "5" "6" "7" "8" "9" "0" "."))) (progn (while (< j (1+ elen)) (if (not (member (setq cc (substr etxt j 1)) '("1" "2" "3" "4" "5" "6" "7" "8" "9" "0" "."))) (setq j (1+ j)) (progn (setq pretxt (substr etxt 1 (- j 1))) (setq etxt (substr etxt j elen)) (setq j (+ elen 2)) (setq noproc 1) );progn );if );while (if (= j (1+ elen)) (setq noproc 1) );if );progn (setq pretxt "") );if ; ; Locate text to modify ; (setq j 1) (setq elen (strlen etxt)) (if (> elen 0) (progn (while (< j (1+ elen)) (if (member (setq cc (substr etxt j 1)) '("1" "2" "3" "4" "5" "6" "7" "8" "9" "0" ".")) (setq j (1+ j)) (progn (if (member cc '("\"" "\'")) (progn (setq noproc 1) (setq j (1+ elen)) );progn (progn (setq txt (substr etxt 1 (- j 1))) (setq posttxt (substr etxt j elen)) (setq j (1+ elen)) );progn );if );progn );if (if (= j elen) (progn (setq txt etxt) (setq posttxt "") );progn );if );while );progn );if ; ; Add BM Change ; (if (= noproc 0) (progn (setq ztxt (rtos (+ (atof txt) bmoff) 2 dprec)) (setq ntxt (strcat pretxt ztxt posttxt)) (setq nz (+ ez bmoff)) ; ; Modifying entity data ; (setq old (assoc 1 ed)) (setq new (cons 1 ntxt)) ; Text value (setq ed (subst new old ed)) (setq ed (subst new old ed)) (entmod ed) (setq mod (1+ mod)) );progn (progn );progn );if (setq i (+ i 1)) );while ) ;progn ; ; result to BM OFFSET = 0 ; (prompt "\n\nProgram terminated. ") );endif (princ "\n\nThere were ")(princ len)(princ " entities processed and ") (princ mod)(princ " entities modified.") ; reset system variables (setvar "regenmode" rm) (setvar "blipmode" bm) (setvar "cmdecho" ce) (setvar "menuecho" me) (princ) ) ;End of CEL Second Script: This script add the value at every number on the string and add the decimal (dont work on block) (defun c:Text_Inc (/ *error* ParseNumbers uFlag ss) (vl-load-com) ;; Lee Mac ~ 10.03.10 (defun *error* (msg) (setvar 'NOMUTT 0) (and uFlag (vla-EndUndoMark *doc)) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **"))) (princ)) (defun ParseNumbers (str / lst Num Aph x rtn) ;; Lee Mac ~ 20.09.09 (setq lst (vl-string->list str) Num "" Aph "") (while (setq x (car lst)) (setq lst (cdr lst)) (cond ( (and (/= "" Num) (= 46 x)) (setq Num (strcat Num (chr x)))) ( (< 47 x 58) (setq Num (strcat Num (chr x)) rtn (cons Aph rtn) Aph "")) (t (setq Aph (strcat Aph (chr x)) rtn (cons (read Num) rtn) Num "")))) (vl-remove nil (vl-remove "" (reverse (cons Aph (cons (read Num) rtn)))))) (setq *inc* (cond (*inc*) (1.0))) (setq *inc* (cond ((getreal (strcat "\nSpecify Increment <" (vl-princ-to-string *inc*) "> : "))) (*inc*))) (setq *doc (cond (*doc) ((vla-get-ActiveDocument (vlax-get-acad-object))))) (setvar 'NOMUTT 1) (princ "\nSelect Text to Increment <All> : ") (if (or (ssget "_:L" '((0 . "MTEXT,TEXT"))) (ssget "_X" '((0 . "MTEXT,TEXT")))) (progn (setq uFlag (not (vla-StartUndoMark *doc))) (vlax-for obj (setq ss (vla-get-ActiveSelectionSet *doc)) (vla-put-TextString obj (apply (function strcat) (mapcar (function (lambda (x) (if (vl-position (type x) '(INT REAL)) (rtos (+ x *inc*) (getvar 'LUNITS) 3) x))) (ParseNumbers (vla-get-TextString obj)))))) (vla-delete ss) (setq uFlag (vla-EndUndoMark *doc)))) (setvar 'NOMUTT 0) (princ)) Quote Link to comment Share on other sites More sharing options...
marko_ribar Posted September 22, 2016 Share Posted September 22, 2016 (edited) Only if delimiter is like in your example "-" and not at all tested... (defun c:lastattnumaddition ( / f-MR numstrchk ss n i bl str splitstr lastnumber pref newpref newstr attlst ) (vl-load-com) (defun f-MR ( d s / d1 dl k ss c pl z l ) (while (and (setq d1 (substr d 1 1)) (/= d1 "")) (setq d (substr d 2)) (setq dl (cons d1 dl)) ) (foreach d1 dl (setq k -1 ss s) (while (and (setq c (substr ss 1 1)) (/= c "")) (setq ss (substr ss 2)) (setq k (1+ k)) (if (= c d1) (setq pl (cons k pl)) ) ) ) (if pl (progn (setq pl (vl-sort pl '<)) (foreach p pl (if (null z) (setq z 1) ) (setq l (cons (substr s z (1+ (- p z))) l)) (setq z (+ p 2)) ) (setq l (cons (substr s z) l)) (vl-remove "" (reverse l)) ) s ) ) (defun numstrchk ( s / ss ssl ) (while (and (setq ss (substr s 1 1)) (/= ss "")) (setq s (substr s 2)) (setq ssl (cons ss ssl)) ) (vl-every '(lambda ( x ) (vl-position x '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))) ssl) ) (prompt "\nSelect blocks to perform operation on...") (setq ss (ssget "_:L" '((0 . "INSERT") (66 . 1)))) (if ss (progn (initget 3) (setq n (getint "\nSpecify number for addition to last number of blocks attributes : ")) (repeat (setq i (sslength ss)) (setq bl (ssname ss (setq i (1- i)))) (foreach att (append (vlax-invoke (vlax-ename->vla-object bl) 'getattributes) (vlax-invoke (vlax-ename->vla-object bl) 'getconstantattributes)) (if (not (vl-position att attlst)) (progn (setq str (vla-get-textstring att)) (if (and (/= str "") (or (and (listp (f-MR "/" str)) (listp (f-MR "-" (car (f-MR "/" str)))) (numstrchk (last (f-MR "-" (car (f-MR "/" str)))))) (and (listp (f-MR "/" str)) (= (type (f-MR "-" (car (f-MR "/" str)))) 'str) (numstrchk (f-MR "-" (car (f-MR "/" str))))) (and (= (type (f-MR "/" str)) 'str) (listp (f-MR "-" str)) (numstrchk (last (f-MR "-" str)))) ) ) (progn (setq splitstr (f-MR "/" str)) (if (listp splitstr) (progn (setq pref (car splitstr)) (setq pref (f-MR "-" pref)) (if (listp pref) (progn (setq lastnumber (last pref)) (setq lastnumber (itoa (+ (atoi lastnumber) n))) (setq pref (reverse (cons lastnumber (cdr (reverse pref))))) (setq newpref "") (foreach s (reverse pref) (setq newpref (strcat s "-" newpref)) ) (setq newpref (vl-string-right-trim "-" newpref)) (setq newstr (strcat newpref "/" (last splitstr))) ) (progn (setq lastnumber (itoa (+ (atoi pref) n))) (setq newstr (strcat lastnumber "/" (last splitstr))) ) ) ) (progn (setq splitstr (f-MR "-" splitstr)) (if (listp splitstr) (progn (setq lastnumber (last splitstr)) (setq lastnumber (itoa (+ (atoi lastnumber) n))) (setq splitstr (reverse (cons lastnumber (cdr (reverse splitstr))))) (setq newstr "") (foreach s (reverse splitstr) (setq newstr (strcat s "-" newstr)) ) (setq newstr (vl-string-right-trim "-" newstr)) ) ) ) ) (vla-put-textstring att newstr) (setq attlst (cons att attlst)) ) ) ) ) ) ) ) ) (princ) ) M.R. Edited September 23, 2016 by marko_ribar Quote Link to comment Share on other sites More sharing options...
Alerie Posted September 22, 2016 Author Share Posted September 22, 2016 Thanks You for the Answer. I tested just now and i recived this error: ; error: no function definition: VLA-PUT-TEXTSTREING ps: is there a chance to let it work also with normal string of text ? sorry for my bad english. Andrea. Quote Link to comment Share on other sites More sharing options...
marko_ribar Posted September 22, 2016 Share Posted September 22, 2016 I saw that typo... It seems that you grabbed the code as soon as I firstly posted, then I corrected that... Maybe try grabbing now once again... What do you mean normal text strings? That would be very similar, but I'd suggest another lisp based on my post... Now try on by yourself, you have something to start with... Report if you're stuck somewhere and post your code for revision... M.R. Quote Link to comment Share on other sites More sharing options...
Alerie Posted September 22, 2016 Author Share Posted September 22, 2016 I never write in LISP, I start soon. I writed only in C,C++, Java, Visual Basic, HTML. To String I thought a text that contains letters numbers and symbols. I must edit Text Box and Attribute of Box. Excuse the misunderstanding. Do you know good lisp manual to read ? or guide to learn ? Andrea Quote Link to comment Share on other sites More sharing options...
marko_ribar Posted September 22, 2016 Share Posted September 22, 2016 Here is the most recent similar request : https://www.theswamp.org/index.php?topic=51989.0 Regards, M.R. Quote Link to comment Share on other sites More sharing options...
Alerie Posted September 23, 2016 Author Share Posted September 23, 2016 Hi, Marko Ribar. I tried your scritp today and I could see that: -Work on -Dont Work on -When you select multiply objects, the script change only the last object selected. Sorry to bother you again, but can you help me again ? I do not think I can read and learn the manual in time and I need this macro to work. Thanks You. Kind Regards Andrea Quote Link to comment Share on other sites More sharing options...
Alerie Posted September 23, 2016 Author Share Posted September 23, 2016 Hi, Marko Ribar. I tried your scritp today and I could see that: -Work on "Block Reference" -Dont Work on "Text" -When you select multiply objects, the script change only the last object selected. Sorry to bother you again, but can you help me again ? I do not think I can read and learn the manual in time and I need this macro to work. Thanks You. Kind Regards Andrea Quote Link to comment Share on other sites More sharing options...
marko_ribar Posted September 23, 2016 Share Posted September 23, 2016 (edited) I've updated my previous code, and try this for texts... (defun c:lasttxtnumaddition ( / f-MR ss n i txt str splitstr lastnumber pref newpref newstr ) (vl-load-com) (defun f-MR ( d s / d1 dl k ss c pl z l ) (while (and (setq d1 (substr d 1 1)) (/= d1 "")) (setq d (substr d 2)) (setq dl (cons d1 dl)) ) (foreach d1 dl (setq k -1 ss s) (while (and (setq c (substr ss 1 1)) (/= c "")) (setq ss (substr ss 2)) (setq k (1+ k)) (if (= c d1) (setq pl (cons k pl)) ) ) ) (if pl (progn (setq pl (vl-sort pl '<)) (foreach p pl (if (null z) (setq z 1) ) (setq l (cons (substr s z (1+ (- p z))) l)) (setq z (+ p 2)) ) (setq l (cons (substr s z) l)) (vl-remove "" (reverse l)) ) s ) ) (prompt "\nSelect texts to perform operation on...") (setq ss (ssget "_:L" '((0 . "TEXT")))) (if ss (progn (initget 3) (setq n (getint "\nSpecify number for addition to last number of texts : ")) (repeat (setq i (sslength ss)) (setq txt (ssname ss (setq i (1- i)))) (setq str (cdr (assoc 1 (entget txt)))) (setq splitstr (f-MR "/" str)) (if (listp splitstr) (progn (setq pref (car splitstr)) (setq pref (f-MR "-" pref)) (if (listp pref) (progn (setq lastnumber (last pref)) (setq lastnumber (itoa (+ (atoi lastnumber) n))) (setq pref (reverse (cons lastnumber (cdr (reverse pref))))) (setq newpref "") (foreach s (reverse pref) (setq newpref (strcat s "-" newpref)) ) (setq newpref (vl-string-right-trim "-" newpref)) (setq newstr (strcat newpref "/" (last splitstr))) ) (progn (setq lastnumber (itoa (+ (atoi pref) n))) (setq newstr (strcat lastnumber "/" (last splitstr))) ) ) ) (progn (setq splitstr (f-MR "-" splitstr)) (if (listp splitstr) (progn (setq lastnumber (last splitstr)) (setq lastnumber (itoa (+ (atoi lastnumber) n))) (setq splitstr (reverse (cons lastnumber (cdr (reverse splitstr))))) (setq newstr "") (foreach s (reverse splitstr) (setq newstr (strcat s "-" newstr)) ) (setq newstr (vl-string-right-trim "-" newstr)) ) ) ) ) (entupd (cdr (assoc -1 (entmod (subst (cons 1 newstr) (assoc 1 (entget txt)) (entget txt)))))) ) ) ) (princ) ) HTH, M.R. Edited September 23, 2016 by marko_ribar Quote Link to comment Share on other sites More sharing options...
marko_ribar Posted September 23, 2016 Share Posted September 23, 2016 Andrea, can you upload DWG showing before situation, and DWG showing after situation what should *.lsp do... You can manually create after situation just on few blocks, but DWG should show what do you need and *.lsp isn't doing as desired... Quote Link to comment Share on other sites More sharing options...
Alerie Posted September 23, 2016 Author Share Posted September 23, 2016 My post at 9.17 It is the same of 9.22. Anyway I'll show you what I have to do. You script work fine 2/4 of case as you can see from the dwg and the script for Block dont work on Multiselection. I have 1,700 pages of dwg to edit and already the script you gave me helps me a lot. If you want to continue to help me I appreciate it, but I would not bother you too. PS: I did all in one dwg in a table. PSS: if you want add me to skype : Andrea Bacciarelli ( as avatar i have a guy with a lot knife in the back and a girl with a wrist bleeding) edit: added 4th case WORK.dwg Quote Link to comment Share on other sites More sharing options...
marko_ribar Posted September 23, 2016 Share Posted September 23, 2016 Andrea, I've updated my codes to reflect your desired request... Kind regards, M.R. Quote Link to comment Share on other sites More sharing options...
marko_ribar Posted September 23, 2016 Share Posted September 23, 2016 I've updated codes to be applicable and for your 4th case... Please revise them... M.R. Quote Link to comment Share on other sites More sharing options...
Alerie Posted September 23, 2016 Author Share Posted September 23, 2016 Thanks you a lot. I love you ! You saved me from editing every tag in 1700 dwg without macro. I owe you. I hope I can repay you in the future Andrea Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.