harshad Posted September 19, 2007 Share Posted September 19, 2007 hi friends i want a lisp for number or alphabetical increment lisp ask me for dist between text and increment valu this is need full i add the sample this is give u idia thanks harshad:) :) SAMPLE.pdf Quote Link to comment Share on other sites More sharing options...
NBC Posted September 19, 2007 Share Posted September 19, 2007 try using the TCOUNT function of Express Tools. Quote Link to comment Share on other sites More sharing options...
ASMI Posted September 19, 2007 Share Posted September 19, 2007 NUM for inserting text, RENUM for changing existing text to numbers: (defun c:num (/ oldPref oldSuf oldStart curStr newNum actDoc actSp oldEcho oldSize *error*) (defun *error* (msg) (setvar "CMDECHO" oldEcho) (princ) ); end *error* (vl-load-com) (if(not num:Size)(setq num:Size(getvar "DIMTXT"))) (if(not num:Pref)(setq num:Pref "")) (if(not num:Suf)(setq num:Suf "")) (if(not num:Num)(setq num:Num 1)) (setq oldPref num:Pref oldSuf num:Suf oldStart num:Num oldSize num:Size actDoc(vla-get-ActiveDocument (vlax-get-acad-object)) oldEcho(getvar "CMDECHO") ); end setq (setvar "CMDECHO" 0) (if(= (vla-get-ActiveSpace actDoc) 1) (setq actSp(vla-get-ModelSpace actDoc)) (setq actSp(vla-get-PaperSpace actDoc)) ); end setq (setq num:Size (getreal (strcat "\nSpecify text size <"(rtos num:Size)">: "))) (if(null num:Size)(setq num:Size oldSize)) (setq num:Pref (getstring T (strcat "\nType prefix: <"num:Pref">: "))) (if(= "" num:Pref)(setq num:Pref oldPref)) (if(= " " num:Pref)(setq num:Pref "")) (setq num:Suf (getstring T (strcat "\nType suffix: <"num:Suf">: "))) (if(= "" num:Suf)(setq num:Suf oldSuf)) (if(= " " num:Suf)(setq num:Suf "")) (setq num:Num (getint (strcat "\nEnter start number <"(itoa num:Num)">: "))) (if(null num:Num)(setq num:Num oldStart)) (while T (setq curStr(strcat num:Pref(itoa num:Num)num:Suf) newNum(vla-AddText actSp curStr (vlax-3d-point '(0.0 0.0 0.0)) num:Size)) (vla-put-Alignment newNum acAlignmentMiddleCenter) (command "_.copybase"(trans '(0.0 0.0 0.0)0 1)(entlast)"") (command "_.erase" (entlast) "") (command "_.pasteclip" pause) (setq num:Num(1+ num:Num)) ); end while (princ) ); end of c:num (defun c:renum (/ oldPref oldSuf oldStart curText curStr) (vl-load-com) (if(not rnm:Pref)(setq rnm:Pref "")) (if(not rnm:Suf)(setq rnm:Suf "")) (if(not rnm:Start)(setq rnm:Start 1)) (setq oldPref rnm:Pref oldSuf rnm:Suf oldStart rnm:Start); end setq (setq rnm:Pref (getstring T (strcat "\nType prefix: <"rnm:Pref">: "))) (if(= "" rnm:Pref)(setq rnm:Pref oldPref)) (if(= " " rnm:Pref)(setq rnm:Pref "")) (setq rnm:Suf (getstring T (strcat "\nType suffix: <"rnm:Suf">: "))) (if(= "" rnm:Suf)(setq rnm:Suf oldSuf)) (if(= " " rnm:Suf)(setq rnm:Suf "")) (setq rnm:Start (getint (strcat "\nEnter start number <" (itoa rnm:Start)">: "))) (if(null rnm:Start)(setq rnm:Start oldStart)) (while T (setq curStr(strcat rnm:Pref(itoa rnm:Start)rnm:Suf)) (setq curText (car (nentsel "\nSelect DText/MText/Attribute or Esc to Quit "))) (if (and curText (member(cdr(assoc 0(entget curText))) '("TEXT" "MTEXT" "ATTRIB")) ); end and (progn (vla-put-TextString (vlax-ename->vla-object curText)curStr) (setq rnm:Start(1+ rnm:Start)) ); end progn (princ "\nThis is not DText or MText! ") ); end if ); end while (princ) ); end of c:renum Quote Link to comment Share on other sites More sharing options...
asos2000 Posted July 14, 2009 Share Posted July 14, 2009 thanx ASMI I was searching for that lisp which renumber attribute. can the increment start with 01 or 001 and what about alphabet (A, B, C, .......Y, Z, AA, AB, ....etc) Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted July 14, 2009 Share Posted July 14, 2009 I believe my AutoNum V4 lisp has this function, choose to Pick Each Insert, and then hit R. Quote Link to comment Share on other sites More sharing options...
VVA Posted July 15, 2009 Share Posted July 15, 2009 thanx ASMII was searching for that lisp which renumber attribute. can the increment start with 01 or 001 ... Look this thread (How about ApnumA command?) And more link: Copying a number and increase the value at the same time and what about alphabet (A, B, C, .......Y, Z, AA, AB, ....etc) I have a wonderful feature INCSUFF (Gilles Chanteau), I adapted it for the Russian alphabet. But Now I do not have time to adapt or write command: ( Links to INCSUFF my adapted version: Attribute ASCII code +1 Increment the suffix of a string (defun incsuff (str inc alpha / lst crt pas ind dep quo ret) ;; INCSUFF -Gilles Chanteau- 2008/01/15 ;; Adds the specified increment to a string suffix. ;; Is considered as suffix, all [0-9] characters from the end of the string ;; more [A-Z] and [a-z] characters if alpha argument is non nil. ;; ;; Adapting to the Russian alphabet VVA (Vladimir Azarko) ;; Arguments ;; str : a string ;; inc : a positive integer ;; alpha : if non nil, [a-z] [A-Z] characters are integrated to suffix. ;; ;; Return ;; The string with incremented suffix (or nil if none valid suffix) ;; ;; Examples : ;; (incsuff "N° 002" 12 T) = "N° 014" ;; (incsuff "Drawing_A" 1 T) = "Drawing_B" ;; (incsuff "test_ZZ9" 1 T) = "test_AAA0" ;; (incsuff "test_ZZ9" 1 nil) = "test_ZZ10" ;; (incsuff "12-" 1 nil) = nil (setq lst (reverse (vl-string->list str))) (while (and (setq crt (car lst)) (cond ((< 47 crt 58) ;_Number (setq pas 10 ;_Step ind 48 ;_ ASCII Code Number 0 ) ;_ end of setq ) ((and alpha (< 64 crt 91)) ;_Upper case latin (setq pas 26 ;_Number of letters in the alphabet (step) ind 65 ;_Upper case latin A (eng) ) ;_ end of setq ) ((and alpha (< 96 crt 123)) ;_Lower case latin (setq pas 26 ;_Number of letters in the alphabet (step) ind 97 ;_Lower case latin A (eng) ) ;_ end of setq ) ((and alpha (< 191 crt 224));_Upper case russian (setq pas 32 ;_Number of letters in the alphabet (step) ind 192 ;_Upper case russian A ) ;_ end of setq ) ((and alpha (< 223 crt 256));_Lower case russian (setq pas 32 ;_Number of letters in the alphabet (step) ind 224 ;_Lower case russian A ) ;_ end of setq ) ((< 0 quo) (setq crt (if (= 10 pas) ind (1- ind) ) ;_ end of if lst (cons (car lst) lst) ) ;_ end of setq ) ) ;_ end of cond ) ;_ end of and (setq dep (- crt ind) quo (/ (+ dep inc) pas) ret (cons (+ ind (rem (+ dep inc) pas)) ret) ) ;_ end of setq (if (zerop quo) (setq ret (append (reverse (cdr lst)) ret) lst nil ) ;_ end of setq (if (cdr lst) (setq lst (cdr lst) inc quo ) ;_ end of setq (setq lst (list ind) inc (if (= 10 pas) quo (1- quo) ) ;_ end of if ) ;_ end of setq ) ;_ end of if ) ;_ end of if ) ;_ end of while (if ret (vl-list->string ret) ) ;_ end of if ) ;_ end of defun Quote Link to comment Share on other sites More sharing options...
VVA Posted July 15, 2009 Share Posted July 15, 2009 can the increment start with 01 or 001 Try it. Number (defun c:numA (/ oldPref oldSuf oldStart curStr newNum actDoc actSp oldEcho oldSize *error* tmpstr) ;;; Numeric with alignment (add 0 before number) of number ;;;Edition 15.17.2009 Vladimir Azarko (VVA) ;;;http://www.cadtutor.net/forum/showthread.php?p=253543 (defun *error* (msg) (setvar "CMDECHO" oldEcho) (princ msg)(princ) ); end *error* (vl-load-com) (if(not num:Size)(setq num:Size(getvar "DIMTXT"))) (if(not num:Pref)(setq num:Pref "")) (if(not num:Suf)(setq num:Suf "")) (if(not num:Num)(setq num:Num 1)) (if(not num:Alig)(setq num:Alig "1")) (setq oldPref num:Pref oldSuf num:Suf oldStart num:Num oldSize num:Size actDoc(vla-get-ActiveDocument (vlax-get-acad-object)) oldEcho(getvar "CMDECHO") ); end setq (setvar "CMDECHO" 0) (if(= (vla-get-ActiveSpace actDoc) 1) (setq actSp(vla-get-ModelSpace actDoc)) (setq actSp(vla-get-PaperSpace actDoc)) ); end setq (setq num:Size (getreal (strcat "\nSpecify text size <"(rtos num:Size)">: "))) (if(null num:Size)(setq num:Size oldSize)) (setq num:Pref (getstring T (strcat "\nType prefix:(If you want to delete prefix type ' ' (press SPACE key on keyboard) <"num:Pref"> :"))) (if(= "" num:Pref)(setq num:Pref oldPref)) (if(= " " num:Pref)(setq num:Pref "")) (setq num:Suf (getstring T (strcat "\nType suffix:(If you want to delete prefix type ' ' (press SPACE key on keyboard) <"num:Suf"> :"))) (if(= "" num:Suf)(setq num:Suf oldSuf)) (if(= " " num:Suf)(setq num:Suf "")) (if(not num:Alig)(setq num:Alig "1")) (setq oldStart num:Alig) (initget "1 10 100 1000 10000 100000") (setq num:Alig (GETKWORD (strcat "\nSpecify alignment of number [1/10/100/1000/10000/100000] <"num:Alig">: "))) (if(null num:Alig)(setq num:Alig oldStart)) (setq oldStart num:Num) (setq num:Num (getint (strcat "\nEnter start number <"(itoa num:Num)">: "))) (if(null num:Num)(setq num:Num oldStart)) (while T (setq oldStart (itoa num:Num)) (while (<= (strlen oldStart)(1- (strlen num:Alig))) (setq oldStart (strcat "0" oldStart))) (setq curStr(strcat num:Pref oldStart num:Suf) newNum(vla-AddText actSp curStr (vlax-3d-point '(0.0 0.0 0.0)) num:Size)) (vla-put-Alignment newNum acAlignmentMiddleCenter) (command "_.copybase"(trans '(0.0 0.0 0.0)0 1)(entlast)"") (command "_.erase" (entlast) "") (command "_.pasteclip" pause) (setq num:Num(1+ num:Num)) ); end while (princ) ); end of c:numA Quote Link to comment Share on other sites More sharing options...
VVA Posted July 15, 2009 Share Posted July 15, 2009 And renumber (defun c:renumA (/ oldPref oldSuf oldStart curText curStr vlaObj keepText ss) ;;;Routine for Renumbering ;;;Realization {Smirnoff} aka ASMI ;;;http://www.autocad.ru/cgi-bin/f1/board.cgi?t=30394Ae ;;;http://www.caduser.ru/cgi-bin/f1/board.cgi?t=29829Am ;;;http://www.autocad.ru/cgi-bin/f1/board.cgi?t=21807yD ;;;Edition 23.10.2006 Vladimir Azarko (VVA) ;;;http://www.autocad.ru/cgi-bin/f1/board.cgi?t=30394Ae ;;;Edition 15.17.2009 Vladimir Azarko (VVA) ;;;http://www.cadtutor.net/forum/showthread.php?p=253543 (vl-load-com) (defun TTC_Paste(pasteStr keepText / nslLst vlaObj) (if (setq nslLst(nentsel "\nPaste text <exit> >>")) (progn (cond ((and (= 4(length nslLst)) (= "DIMENSION"(cdr(assoc 0(entget(car(last nslLst))))))); end and (setq vlaObj (vlax-ename->vla-object (cdr(assoc -1(entget(car(last nslLst))))))) (setq oldStat (vla-get-Measurement vlaObj)) (if keepText (if (= (vla-get-TextOverride vlaObj) "") (setq pasteStr (strcat pasteStr (rtos oldStat (vla-get-UnitsFormat vlaObj) (vla-get-PrimaryUnitsPrecision vlaObj)))) (setq pasteStr (strcat pasteStr (vla-get-TextOverride vlaObj))))) (if (vl-catch-all-error-p(vl-catch-all-apply 'vla-put-TextOverride(list vlaObj pasteStr))) (princ "\n Can't paste. Object may be on locked layer. "))); end condition #1 ((and (= 4(length nslLst)) (= "ACAD_TABLE"(cdr(assoc 0(entget(car(last nslLst))))))); end and (setq vlaObj (vlax-ename->vla-object(car nslLst))) (if keepText (setq pasteStr (strcat pasteStr (vla-get-TextString vlaobj)))) (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-TextString(list vlaObj pasteStr))) (princ "\nError. Can't pase text. ")(entupd (car(last nslLst))))); end condition # 2 ((and (= 4(length nslLst)) (= "INSERT"(cdr(assoc 0(entget(car(last nslLst))))))); end and (princ "\nCan't paste to block's DText or MText. ")); end condition #3 ((and (= 2(length nslLst)) (member(cdr(assoc 0(entget(car nslLst)))) '("TEXT" "MTEXT" "ATTRIB" "ATTDEF"))); end and (setq vlaObj (vlax-ename->vla-object(car nslLst))) (if keepText (setq pasteStr (strcat pasteStr (vla-get-TextString vlaobj)))) (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-TextString(list vlaObj pasteStr))) (princ "\nError. Can't pase text. "))); end condition #4 (T (princ "\nCan't paste. Invalid object. ")); end condition #5 ); end cond T); end progn nil); end if );_TTC_PASTE (setq aDoc(vla-get-ActiveDocument(vlax-get-acad-object))) (vla-StartUndoMark aDoc) (if(not rnm:Pref)(setq rnm:Pref ""))(if(not rnm:Suf)(setq rnm:Suf "")) (if(not rnm:Start)(setq rnm:Start 1)) (if(not num:Alig)(setq num:Alig "1")) (setq oldPref rnm:Pref oldSuf rnm:Suf); end setq (setq rnm:Pref (getstring T (strcat "\nType prefix:(If you want to delete prefix type ' ' (press SPACE key on keyboard) <" rnm:Pref "> :"))) (if(= "" rnm:Pref)(setq rnm:Pref oldPref))(if(= " " rnm:Pref)(setq rnm:Pref "")) (setq rnm:Suf (getstring T (strcat "\nType suffix:(If you want to delete prefix type ' ' (press SPACE key on keyboard) <"rnm:Suf"> :"))) (if(= "" rnm:Suf)(setq rnm:Suf oldSuf))(if(= " " rnm:Suf)(setq rnm:Suf "")) (setq oldStart num:Alig) (initget "1 10 100 1000 10000 100000") (setq num:Alig (GETKWORD (strcat "\nSpecify alignment of number [1/10/100/1000/10000/100000] <"num:Alig">: "))) (if(null num:Alig)(setq num:Alig oldStart)) (setq oldStart rnm:Start rnm:Start (getint (strcat "\nEnter start number <" (itoa rnm:Start)">: "))) (if(null rnm:Start)(setq rnm:Start oldStart)) (initget "Yes No ?? ??? _Yes No Yes No") (setq keepText (not (= "No" (getkword "\nkeep contents of the text [Yes/No] <Yes>:")))) (setq rnm:Start (1- rnm:Start)) (while (progn (setq oldStart (itoa (setq rnm:Start(1+ rnm:Start)))) (while (<= (strlen oldStart)(1- (strlen num:Alig))) (setq oldStart (strcat "0" oldStart))) (TTC_Paste (setq curStr(strcat rnm:Pref oldStart rnm:Suf)) keepText))) (vla-EndUndoMark aDoc)(princ)); end of c:renumA Quote Link to comment Share on other sites More sharing options...
asos2000 Posted July 15, 2009 Share Posted July 15, 2009 Is there an English version of www.autocad.ru site Quote Link to comment Share on other sites More sharing options...
asos2000 Posted July 15, 2009 Share Posted July 15, 2009 How can i change the default answer is No nkeep contents of the text [Yes/No] Quote Link to comment Share on other sites More sharing options...
VVA Posted July 15, 2009 Share Posted July 15, 2009 Before (setq keepText (not (= "No" (getkword "\nkeep contents of the text [Yes/No] <Yes>:")))) After (setq keepText (= "Yes" (getkword "\nkeep contents of the text [Yes/No] <No>:"))) Quote Link to comment Share on other sites More sharing options...
Arizona Posted October 29, 2010 Share Posted October 29, 2010 I need one that will add 0.5 to text via a window. Example: I have 100 of these: FF=123.45 (many different numbers) I need them to change to: 123.95 Thanks. Quote Link to comment Share on other sites More sharing options...
fixo Posted October 31, 2010 Share Posted October 31, 2010 Is there what you need? (defun addto (string prefix value) (strcat prefix (vl-princ-to-string (+ value (distof (vl-string-subst "" prefix string)) ))) ) (defun c:atot (/ ELIST EN PFX SS VALUE) (setq pfx (getstring T "\n ENter text prefix <FF=>: ")) (if (eq "" pfx) (setq pfx "FF=")) (setq value (getreal "\n Enter number to add to: ")) (setq ss (ssget (list (cons 0 "TEXT") (cons 1 (strcat pfx "*"))))) (while (setq en (ssname ss 0)) (setq elist (entget en)) (entmod (subst (cons 1 (addto (cdr (assoc 1 elist)) pfx value)) (assoc 1 elist) elist)) (ssdel en ss)) (princ) ) ~'J'~ Quote Link to comment Share on other sites More sharing options...
tmelancon Posted December 3, 2014 Share Posted December 3, 2014 I know it has been a while but is there a way we can allow for decimals in this code? lets say I have #1-#9 on a drawing and I want the numbers to now be #3.1-#3.9 or even #3.01-#3.09 Can we manipulate the code to allow for this format? If so that would be one hell of a lisp for me. 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.