Jump to content

lisp want for increment


harshad

Recommended Posts

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

Link to comment
Share on other sites

  • 1 year later...

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)

Link to comment
Share on other sites

thanx ASMI

I 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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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>:")))

Link to comment
Share on other sites

  • 1 year later...

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'~

Link to comment
Share on other sites

  • 4 years later...

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.

Link to comment
Share on other sites

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...