Jump to content

Lisp for adding number to multiple text entities?


EvilSi

Recommended Posts

Did you ever manage to to solve this one flopo?

 

Hello everybody,

If i have a block with an attribute, ... B1, is it possible to add a number to this attribute, to be B2? Thanks!

Link to comment
Share on other sites

  • 1 year later...
  • Replies 30
  • Created
  • Last Reply

Top Posters In This Topic

  • gilsoto13

    7

  • Lee Mac

    6

  • Commandobill

    4

  • EvilSi

    3

Top Posters In This Topic

Posted Images

I am using this LSP below and I really love it. However, I am using it for laser printer wire tag sheets, and I have leading zeros on numbers. Any way of supporting that? Right now if I add a number to something like "A0103", I get "A104".

 

wEell... I was updating my help files and found I already had this one from years ago.... and actually works as I expect for numbers and text as objects... I just didn´t remember....

; Increments the first postive number in a TEXT string by the given increment
;;; ==========================================================================
;;;  Program: INC.LSP  ver 1.22
;;;                                                                         
;;;  Purpose: Increments the first postive number in a TEXT string by the given increment
;;;
;;;  Syntax:  INC
;;;
;;;           Resolutions                                                   
;;;           P.O. Box 1265                                                 
;;;           Sumner WA 98390-0250                                          
;;;           206-845-2200                                                  
;;;
;;;  Date:             5/10/95
;;;
;;;  Revisions:  ver 1.1  8/7/95    Added support for REALs
;;;
;;;  Revisions:  ver 1.2  12/12/95  Added support for Stations
;;;
;;;  Revisions:  ver 1.21 12/14/95  Fixed problem with decimal places
;;;
;;;  Revisions:  ver 1.22 1/16/96   Fixed problem with decimal places when
;;;                                 number is preceeded by alpha characters.
;;; ==========================================================================
(defun C:INC (/ ; Functions & Variables
   ; Functions
           val put r_fill getdp at
   ; Variables
           ss inc i l e j k ascii_nr string newstring nr count dp1 dp
           OldStation dp_pos end_pos
   )
;=============================
; Entity assoc list utilities
;-----------------------------
(defun val (nr e) (cdr (assoc nr e)))
(defun put (x nr e)(subst (cons nr x) (assoc nr e) e))
;;; ==========================================================================
;;; Function: AT
;;; Purpose : Returns the position of the first occurance of a string
;;;           or NIL if not found
;;; Params  : string        String to search
;;;               char            String to locate
;;;
;;; Uses    : 
;;; --------------------------------------------------------------------------
   (defun at (string char / i len clen)
       (if string
           (progn
               (setq i 1 len (strlen string) clen (strlen char))
               (while (and (<= i len) (/= (substr string i clen) char))
                   (setq i (1+ i))
               )
               (if (> i len)
                   (setq i nil)
               )
               (eval i)
           )
       )
   )
;;; ==========================================================================
;;; Function: R_FILL <string> <len>
;;; Purpose : Returns a string filled with spaces on the right
;;;
;;; Params  : string        String to fill
;;;           len             String length
;;;
;;; --------------------------------------------------------------------------
(defun r_fill (s len / space i)
  (setq space "" i (- len (strlen s)))
  (if (> i 0)
      (substr (strcat s (repeat i (setq space (strcat space " ")))) 1 len)
      s
  )
)
;; Return number of decimal places of a REAL
(defun getdp (nr / n)
   (setq n 0 nr (abs nr))
   (while (null (equal (fix (+ nr 0.5)) nr 0.000001))
       (setq n (1+ n))
       (setq nr (* nr 10))
   )
   n
)
;;; ==========================================================================
   ;-- Start C:TEXTINC
   (setvar "CMDECHO" 0)
   (princ "\nSelect TEXT containing NUMBERS to increment.")
   (if (and
           (setq ss (ssget '((0 . "*TEXT"))))
           (setq inc (getreal "\nIncrement: "))
           (/= inc 0)
       )
       (progn
           (setq i 0 l (sslength ss) count 0)
           (while (< i l)
               (setq e (entget (ssname ss i)))
               (setq string (val 1 e))
               ;; --- Check for an number ---
               (if (and 
                       (wcmatch string "*[0-9]*")       ; Find an INT
;                        (wcmatch string "~*#.#*")        ; No REALs
                       (wcmatch string "~*%%d*")        ; No BEARINGS
                   )
                   (progn
                       (setq count (1+ count))
                       (setq j 1 k (strlen string))
                       (if (wcmatch string "*#+##*")  ; Check for Station
                           (setq
                               OldStation string
                               j (at string "+")
                               string (strcat
                                       (substr string 1 (1- j))
                                       (substr string (1+ j))
                                   )
                               j 1
                               k (strlen string)
                           )
                       )
                       ;; --- Step though the string looking
                       ;; --- for the first int ---
                       (while (<= j k)
                           (setq ascii_nr (ascii (substr string j 1)))
                           (if (and (>= ascii_nr 48)(<= ascii_nr 57))
                               (progn
                                   (setq end_pos j)
                                   (while (or (= ascii_nr 46)(and (>= ascii_nr 48)(<= ascii_nr 57)))
                                       (setq
                                           end_pos (1+ end_pos)
                                           ascii_nr (ascii (substr string end_pos 1))
                                       )
                                   )
                                   (setq
                                       dp_pos (at (substr string j) ".")
                                       nr    (atof (substr string j))
                                       dp1 (if dp_pos (- end_pos dp_pos j) 0)
                                       dp (max dp1 (getdp inc))
                                       nr (+ nr inc)
                                       newstring (strcat 
                                           (substr string 1 (1- j))
                                           (rtos nr 2 dp)
                                           (substr string end_pos)
                                       )
                                       j k     ;; Now exit
                                   )
                               )
                           )
                           (setq j (1+ j))
                       )
                       ;; If station then insert the "+"
                       (if OldStation
                           (progn
                               (setq string Oldstation)
                               (if (setq j (at newstring "."))
                                   (setq j (- j 3))
                                   (setq j (- (strlen newstring) 2))
                               )
                               (setq newstring
                                   (strcat (substr newstring 1 j) "+"
                                           (substr newstring (1+ j))
                                   )
                               )
                           )
                       )
                       ;; --- Echo changes to screen ---
                       (princ (strcat "\n" (r_fill string 12) "-->  " newstring))
                       ;; --- Update the TEXT entity ---
                       (entmod (put newstring 1 e))
                   )
                   (princ (strcat "\nNo Numeric value: " string))
               )
               (setq i (1+ i))
           )
           (princ (strcat "\n" (itoa count) " TEXT number\(s\) incremented."))
       )
       (princ "\nTEXTINC cancelled.")
   )
   (princ)
)
(princ "\nTEXTINC.LSP v1.22")
(princ)

Link to comment
Share on other sites

I am using this LSP below and I really love it. However, I am using it for laser printer wire tag sheets, and I have leading zeros on numbers. Any way of supporting that? Right now if I add a number to something like "A0103", I get "A104".

 

You can solve it by using the command "FIND" after you use the INC, and find all A1 text and replace them by A01....

Link to comment
Share on other sites

I have one drawing with above 1000 ground level. I need to add a common value with that levels . any lisp for that calculation. Please help me. I attached that sample drawing. Please help me.

Eg. 269.222+0.253

269.235 + 0.253

279.325+0.253 Etc......... I got one lisp for that but one problem, if iam using that lisp, i need to select all numbers one by one. so pls help for me adding that value at one time.............

new block.dwg

Link to comment
Share on other sites

  • 7 months later...
wEell... I was updating my help files and found I already had this one from years ago.... and actually works as I expect for numbers and text as objects... I just didn´t remember....

; Increments the first postive number in a TEXT string by the given increment
;;; ==========================================================================
;;;  Program: INC.LSP  ver 1.22
;;;                                                                         
;;;  Purpose: Increments the first postive number in a TEXT string by the given increment
;;;
;;;  Syntax:  INC
;;;
;;;           Resolutions                                                   
;;;           P.O. Box 1265                                                 
;;;           Sumner WA 98390-0250                                          
;;;           206-845-2200                                                  
;;;
;;;  Date:             5/10/95
;;;
;;;  Revisions:  ver 1.1  8/7/95    Added support for REALs
;;;
;;;  Revisions:  ver 1.2  12/12/95  Added support for Stations
;;;
;;;  Revisions:  ver 1.21 12/14/95  Fixed problem with decimal places
;;;
;;;  Revisions:  ver 1.22 1/16/96   Fixed problem with decimal places when
;;;                                 number is preceeded by alpha characters.
;;; ==========================================================================
(defun C:INC (/ ; Functions & Variables
   ; Functions
           val put r_fill getdp at
   ; Variables
           ss inc i l e j k ascii_nr string newstring nr count dp1 dp
           OldStation dp_pos end_pos
   )
;=============================
; Entity assoc list utilities
;-----------------------------
(defun val (nr e) (cdr (assoc nr e)))
(defun put (x nr e)(subst (cons nr x) (assoc nr e) e))
;;; ==========================================================================
;;; Function: AT
;;; Purpose : Returns the position of the first occurance of a string
;;;           or NIL if not found
;;; Params  : string        String to search
;;;               char            String to locate
;;;
;;; Uses    : 
;;; --------------------------------------------------------------------------
   (defun at (string char / i len clen)
       (if string
           (progn
               (setq i 1 len (strlen string) clen (strlen char))
               (while (and (<= i len) (/= (substr string i clen) char))
                   (setq i (1+ i))
               )
               (if (> i len)
                   (setq i nil)
               )
               (eval i)
           )
       )
   )
;;; ==========================================================================
;;; Function: R_FILL <string> <len>
;;; Purpose : Returns a string filled with spaces on the right
;;;
;;; Params  : string        String to fill
;;;           len             String length
;;;
;;; --------------------------------------------------------------------------
(defun r_fill (s len / space i)
  (setq space "" i (- len (strlen s)))
  (if (> i 0)
      (substr (strcat s (repeat i (setq space (strcat space " ")))) 1 len)
      s
  )
)
;; Return number of decimal places of a REAL
(defun getdp (nr / n)
   (setq n 0 nr (abs nr))
   (while (null (equal (fix (+ nr 0.5)) nr 0.000001))
       (setq n (1+ n))
       (setq nr (* nr 10))
   )
   n
)
;;; ==========================================================================
   ;-- Start C:TEXTINC
   (setvar "CMDECHO" 0)
   (princ "\nSelect TEXT containing NUMBERS to increment.")
   (if (and
           (setq ss (ssget '((0 . "*TEXT"))))
           (setq inc (getreal "\nIncrement: "))
           (/= inc 0)
       )
       (progn
           (setq i 0 l (sslength ss) count 0)
           (while (< i l)
               (setq e (entget (ssname ss i)))
               (setq string (val 1 e))
               ;; --- Check for an number ---
               (if (and 
                       (wcmatch string "*[0-9]*")       ; Find an INT
;                        (wcmatch string "~*#.#*")        ; No REALs
                       (wcmatch string "~*%%d*")        ; No BEARINGS
                   )
                   (progn
                       (setq count (1+ count))
                       (setq j 1 k (strlen string))
                       (if (wcmatch string "*#+##*")  ; Check for Station
                           (setq
                               OldStation string
                               j (at string "+")
                               string (strcat
                                       (substr string 1 (1- j))
                                       (substr string (1+ j))
                                   )
                               j 1
                               k (strlen string)
                           )
                       )
                       ;; --- Step though the string looking
                       ;; --- for the first int ---
                       (while (<= j k)
                           (setq ascii_nr (ascii (substr string j 1)))
                           (if (and (>= ascii_nr 48)(<= ascii_nr 57))
                               (progn
                                   (setq end_pos j)
                                   (while (or (= ascii_nr 46)(and (>= ascii_nr 48)(<= ascii_nr 57)))
                                       (setq
                                           end_pos (1+ end_pos)
                                           ascii_nr (ascii (substr string end_pos 1))
                                       )
                                   )
                                   (setq
                                       dp_pos (at (substr string j) ".")
                                       nr    (atof (substr string j))
                                       dp1 (if dp_pos (- end_pos dp_pos j) 0)
                                       dp (max dp1 (getdp inc))
                                       nr (+ nr inc)
                                       newstring (strcat 
                                           (substr string 1 (1- j))
                                           (rtos nr 2 dp)
                                           (substr string end_pos)
                                       )
                                       j k     ;; Now exit
                                   )
                               )
                           )
                           (setq j (1+ j))
                       )
                       ;; If station then insert the "+"
                       (if OldStation
                           (progn
                               (setq string Oldstation)
                               (if (setq j (at newstring "."))
                                   (setq j (- j 3))
                                   (setq j (- (strlen newstring) 2))
                               )
                               (setq newstring
                                   (strcat (substr newstring 1 j) "+"
                                           (substr newstring (1+ j))
                                   )
                               )
                           )
                       )
                       ;; --- Echo changes to screen ---
                       (princ (strcat "\n" (r_fill string 12) "-->  " newstring))
                       ;; --- Update the TEXT entity ---
                       (entmod (put newstring 1 e))
                   )
                   (princ (strcat "\nNo Numeric value: " string))
               )
               (setq i (1+ i))
           )
           (princ (strcat "\n" (itoa count) " TEXT number\(s\) incremented."))
       )
       (princ "\nTEXTINC cancelled.")
   )
   (princ)
)
(princ "\nTEXTINC.LSP v1.22")
(princ)

 

This is sooooo close to what I'm looking for! But can anyone tell me how I can modify the lisp so that it'll not just change the first number in an MTEXT object but all? And also have the results displayed in 2 decimal places instead of 3?

Link to comment
Share on other sites

  • 2 months later...

Hi, I would also like to inquire about modifying gilsoto13's lisp. What I have are text fields that describe a string of devices that are connected together. These devices are numbered 1/1, 1/2, 1/3, etc. (meaning String 1/Device 1, String 1/Device 2 etc.). Sometimes I have to insert a device in between other devices, so I have to redo the numeration. E.g. if I insert a new device between 1/2 and 1/3, then the new device becomes 1/3 and the "old" 1/3 becomes 1/4 and so on.

 

What I need is a routine to scan for the slash character ("/") and only sum 1 to the number following the slash.

 

Could someone help me with that, maybe using gilsoto13's lisp a few posts above?

Link to comment
Share on other sites

  • 5 years later...
On 4/3/2010 at 11:27 PM, gilsoto13 said:

wEell... I was updating my help files and found I already had this one from years ago.... and actually works as I expect for numbers and text as objects... I just didn´t remember....

 


; Increments the first postive number in a TEXT string by the given increment
;;; ==========================================================================
;;;  Program: INC.LSP  ver 1.22
;;;                                                                         
;;;  Purpose: Increments the first postive number in a TEXT string by the given increment
;;;
;;;  Syntax:  INC
;;;
;;;           Resolutions                                                   
;;;           P.O. Box 1265                                                 
;;;           Sumner WA 98390-0250                                          
;;;           206-845-2200                                                  
;;;
;;;  Date:             5/10/95
;;;
;;;  Revisions:  ver 1.1  8/7/95    Added support for REALs
;;;
;;;  Revisions:  ver 1.2  12/12/95  Added support for Stations
;;;
;;;  Revisions:  ver 1.21 12/14/95  Fixed problem with decimal places
;;;
;;;  Revisions:  ver 1.22 1/16/96   Fixed problem with decimal places when
;;;                                 number is preceeded by alpha characters.
;;; ==========================================================================
(defun C:INC (/ ; Functions & Variables
   ; Functions
           val put r_fill getdp at
   ; Variables
           ss inc i l e j k ascii_nr string newstring nr count dp1 dp
           OldStation dp_pos end_pos
   )
;=============================
; Entity assoc list utilities
;-----------------------------
(defun val (nr e) (cdr (assoc nr e)))
(defun put (x nr e)(subst (cons nr x) (assoc nr e) e))
;;; ==========================================================================
;;; Function: AT
;;; Purpose : Returns the position of the first occurance of a string
;;;           or NIL if not found
;;; Params  : string        String to search
;;;               char            String to locate
;;;
;;; Uses    : 
;;; --------------------------------------------------------------------------
   (defun at (string char / i len clen)
       (if string
           (progn
               (setq i 1 len (strlen string) clen (strlen char))
               (while (and (<= i len) (/= (substr string i clen) char))
                   (setq i (1+ i))
               )
               (if (> i len)
                   (setq i nil)
               )
               (eval i)
           )
       )
   )
;;; ==========================================================================
;;; Function: R_FILL <string> <len>
;;; Purpose : Returns a string filled with spaces on the right
;;;
;;; Params  : string        String to fill
;;;           len             String length
;;;
;;; --------------------------------------------------------------------------
(defun r_fill (s len / space i)
  (setq space "" i (- len (strlen s)))
  (if (> i 0)
      (substr (strcat s (repeat i (setq space (strcat space " ")))) 1 len)
      s
  )
)
;; Return number of decimal places of a REAL
(defun getdp (nr / n)
   (setq n 0 nr (abs nr))
   (while (null (equal (fix (+ nr 0.5)) nr 0.000001))
       (setq n (1+ n))
       (setq nr (* nr 10))
   )
   n
)
;;; ==========================================================================
   ;-- Start C:TEXTINC
   (setvar "CMDECHO" 0)
   (princ "\nSelect TEXT containing NUMBERS to increment.")
   (if (and
           (setq ss (ssget '((0 . "*TEXT"))))
           (setq inc (getreal "\nIncrement: "))
           (/= inc 0)
       )
       (progn
           (setq i 0 l (sslength ss) count 0)
           (while (< i l)
               (setq e (entget (ssname ss i)))
               (setq string (val 1 e))
               ;; --- Check for an number ---
               (if (and 
                       (wcmatch string "*[0-9]*")       ; Find an INT
;                        (wcmatch string "~*#.#*")        ; No REALs
                       (wcmatch string "~*%%d*")        ; No BEARINGS
                   )
                   (progn
                       (setq count (1+ count))
                       (setq j 1 k (strlen string))
                       (if (wcmatch string "*#+##*")  ; Check for Station
                           (setq
                               OldStation string
                               j (at string "+")
                               string (strcat
                                       (substr string 1 (1- j))
                                       (substr string (1+ j))
                                   )
                               j 1
                               k (strlen string)
                           )
                       )
                       ;; --- Step though the string looking
                       ;; --- for the first int ---
                       (while (<= j k)
                           (setq ascii_nr (ascii (substr string j 1)))
                           (if (and (>= ascii_nr 48)(<= ascii_nr 57))
                               (progn
                                   (setq end_pos j)
                                   (while (or (= ascii_nr 46)(and (>= ascii_nr 48)(<= ascii_nr 57)))
                                       (setq
                                           end_pos (1+ end_pos)
                                           ascii_nr (ascii (substr string end_pos 1))
                                       )
                                   )
                                   (setq
                                       dp_pos (at (substr string j) ".")
                                       nr    (atof (substr string j))
                                       dp1 (if dp_pos (- end_pos dp_pos j) 0)
                                       dp (max dp1 (getdp inc))
                                       nr (+ nr inc)
                                       newstring (strcat 
                                           (substr string 1 (1- j))
                                           (rtos nr 2 dp)
                                           (substr string end_pos)
                                       )
                                       j k     ;; Now exit
                                   )
                               )
                           )
                           (setq j (1+ j))
                       )
                       ;; If station then insert the "+"
                       (if OldStation
                           (progn
                               (setq string Oldstation)
                               (if (setq j (at newstring "."))
                                   (setq j (- j 3))
                                   (setq j (- (strlen newstring) 2))
                               )
                               (setq newstring
                                   (strcat (substr newstring 1 j) "+"
                                           (substr newstring (1+ j))
                                   )
                               )
                           )
                       )
                       ;; --- Echo changes to screen ---
                       (princ (strcat "\n" (r_fill string 12) "-->  " newstring))
                       ;; --- Update the TEXT entity ---
                       (entmod (put newstring 1 e))
                   )
                   (princ (strcat "\nNo Numeric value: " string))
               )
               (setq i (1+ i))
           )
           (princ (strcat "\n" (itoa count) " TEXT number\(s\) incremented."))
       )
       (princ "\nTEXTINC cancelled.")
   )
   (princ)
)
(princ "\nTEXTINC.LSP v1.22")
(princ)

 

 

Hi all I tried this code for a situation where I need to change the drawing numbers. The situation here is to change the last digit(s) in the end number of the text string but the code is changing the last digits of the first text string. Example D-1501-ERS-2000 has to be changed to D-1501-ERS-2001 and the next text D-1501-ERS-2001 to D-1501-ERS-2002 but the code is changing D-1501-ERS-2000 to D-1502-ERS-2000 and so on. How can this be done.

Thanks

Link to comment
Share on other sites

Look for "-" in a string find last then anything past that is your number so use substr for 1st part join to new number and replace.

 

If its always last 4 its easier use strlen then substr to get last 4 digits change and again join strlen - 4 + new number.

Link to comment
Share on other sites

Here is what I use,. It increases the last character in a single text string. Commanf 'Uprev'

 

(defun c:uprev( / ent entlist currentrevision revlength revisionprefix anumber ones tens hundreds thousands leadingzero dday mmonth yyear yyyear daysinmonth monthlength revcode revletter increaseby sel endloop)

;;get increase / text object
  (setq endloop "No")
  (if (= increments nil) (setq increments 1))
  (setq sel "1")

  (while (= endloop "No")
    (initget "4 3 2 1 0 -1 -2 -3 -4 Exit")
    (setq sel (nentsel (strcat "\nSelect Text or Enter Text Increment (" (itoa increments) ") [3/2/1/0/-1/-2/-3/Exit]: ") ) )
    (cond
      (  (null sel)(princ "\nMissed! Select text, enter increment or press <escape> or 'E'\n") )
      (  (= "Exit" sel)(princ)(exit) )
      (  (= "-3" sel)(setq increments (atoi sel)) )
      (  (= "-4" sel)(setq increments (atoi sel)) )
      (  (= "-2" sel)(setq increments (atoi sel)) )
      (  (= "-1" sel)(setq increments (atoi sel)) )
      (  (= "0" sel) (setq increments (atoi sel)) )
      (  (= "1" sel) (setq increments (atoi sel)) )
      (  (= "2" sel) (setq increments (atoi sel)) )
      (  (= "3" sel) (setq increments (atoi sel)) )
      (  (= "4" sel) (setq increments (atoi sel)) )
      (  (if (and (cdr (assoc 1 (entget (car sel))))(wcmatch (cdr (assoc 0 (entget (car sel)))) "TEXT,MTEXT,ATTRIB") ) (setq endloop "Yes")) )
      (  (if (not (wcmatch (cdr (assoc 0 (entget (car sel)))) "TEXT,MTEXT,ATTRIB") ) (princ "\nThats not text...\n")) )
    )
  ) ;;end while

  (setq ent (car sel))
  (setq entlst (entget ent))
  (princ (setq base (cdr (assoc 1 entlst))) )

  (uprev base sel increments)
)

(defun uprev (base sel increments / ent entlist currentrevision revlength revisionprefix anumber ones tens hundreds thousands leadingzero dday mmonth yyear yyyear daysinmonth monthlength revcode revletter increaseby sel endloop)

  (setq ent (car sel))
  (setq entlst (entget ent))
  (setq currentrevision (cdr (assoc 1 entlst)))

  (setq currentrevision base)


  (setq revlength (strlen currentrevision)) ;;length of selected revision
  (setq revisionprefix "")
  (setq anumber 0)

;;date processing
  (setq dday "")
  (if (and (or (= revlength 8)(= revlength 10))(or (if = (wcmatch currentrevision "??/??/*") t)(if = (wcmatch currentrevision "??.??.*") t)))
    (progn

      (setq dday (atoi (substr currentrevision 1 2)))
      (setq mmonth (atoi (substr currentrevision 4 2))) ;; as integer
      (setq yyear (atoi (substr currentrevision (- revlength 1) 2))) ;; last 2 digits as integer.
      (setq ddaysinmonth (list 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 1))
      (setq daysinmonth (list 31 28 31 30 31 30 31 31 30 31 30 31))
      (setq monthsinyear (list 1 2 3 4 5 6 7 8 9 10 11 12 1))
      (setq yyyear (atoi (substr currentrevision 7 2)))

      (if (= revlength 10)(setq yyyear (itoa yyyear)))(if (= revlength 8)(setq yyyear "")) ;; works out for 'nnxx' in date

      (setq monthlength (nth (- mmonth 1) daysinmonth)) ;;days in the month
      (if (and (= mmonth 2)(= (float (/ yyear 0.4)) (* (fix (/ yyear 4)) 10) ) )(setq monthlength 29)) ;; corrects for leap year
      (setq ddaysinmonth (subst 1 (+ monthlength 1) ddaysinmonth) ) ;; days in the month

      (setq acount increments)
      (while (< 0 acount) ;;if increase rev
        (setq dday (nth dday ddaysinmonth)) ;;increase day by 1
        (if (= dday 1) (setq mmonth (nth mmonth monthsinyear)) ) ;;if day went to 1st, increase month
        (if (and (= dday 1)(= mmonth 1)) (setq yyear (+ yyear 1)) )
        (if (= 100 yyear)(if (/= "" yyyear)(setq yyyear (itoa (+ 1 (atoi yyyear))))))
        (if (= 100 yyear)(setq yyear 00))
        (setq acount (- acount 1))
      ) ;end while

      (setq acount increments)
      (while (> 0 acount) ;;if decrease rev
        (setq dday (- dday 1)) ;;decrease day by 1
        (if (= 0 dday)
          (progn
            (setq mmonth (- mmonth 1))
            (if (= mmonth 0)
              (progn
                (if (= yyear 0)
                  (progn
                    (setq yyear 100)
                    (if (/= "" yyyear) (setq yyyear (itoa (- (atoi yyyear) 1))))
                  )
                )
                (setq yyear (- yyear 1))
                (setq mmonth 12)
              )
            )
            (setq dday (nth (- mmonth 1) daysinmonth))
          )
        )
        (setq acount (+ acount 1))
      ) ;end while

      (if (> 10 yyear)
        (progn
          (if (/= "" yyyear) (setq yyyear (itoa (* 10 (atoi yyyear))) ))
          (if (= "" yyyear) (setq yyyear "0"))
        )
      )

      (setq breaker "/")
      (if (= (vl-string-search "." currentrevision) 2) (setq breaker "." ) )
      (setq revletter (strcat (cond ((< dday 10) "0")(t "")) (itoa dday) breaker (cond ((< mmonth 10) "0")(t "")) (itoa mmonth) breaker yyyear (itoa yyear)       ))
    )
  )
;;;end of date processing

;;number processing
(if (= dday "")(progn
  (if (< 0 revlength)(progn
      (setq ones (substr currentrevision revlength))
      (if (numberp (read ones))(setq anumber 1))
  ))
  (if (< 1 revlength)(progn
      (setq tens (substr (substr currentrevision (- revlength 1) 2 ) 1 1))
      (if (and (= 1 anumber) (numberp (read tens))) (setq anumber 2))
  ))
  (if (< 2 revlength)(progn
      (setq hundreds (substr (substr currentrevision (- revlength 2) 2 ) 1 1))
      (if (and (= 2 anumber) (numberp (read hundreds))) (setq anumber 3))
  ))
  (if (< 3 revlength)(progn
      (setq thousands (substr (substr currentrevision (- revlength 3) 3 ) 1 1))
      (if (and (= 3 anumber) (numberp (read thousands))) (setq anumber 4))
  ))
  
;;work out numerical revision.
  (if (> anumber 0)
    (progn
      (setq revnumber (substr currentrevision (- revlength (- anumber 1)) anumber))
      (setq revnumber (itoa (+ increments (read revnumber)))) ;;increase rev number by 1
      (if (and (> revlength anumber)(/= revlength anumber))
        (setq revisionprefix (substr currentrevision 1 (- revlength anumber))) ;;first characters of revision
      )

      ;;fix leading zeros
      (setq leadingzeros (- anumber (strlen revnumber)))
      (if (= 3 leadingzeros)(setq leadingzero "000"))
      (if (= 2 leadingzeros)(setq leadingzero "00"))
      (if (= 1 leadingzeros)(setq leadingzero "0"))
      (if (> 1 leadingzeros)(setq leadingzero ""))

      (setq revletter (strcat revisionprefix leadingzero revnumber))
    )
  )

;;Work out letters revisions
  (if (= anumber 0)
    (progn
      (setq revcode (+ increments (ascii ones))) ;;increase rev letter by 1

      ;;set exceptions here
      (if (= 73 revcode)(setq revcode 74)) ;;I
      (if (= 79 revcode)(setq revcode 80)) ;;O
      (if (= 105 revcode)(setq revcode 106)) ;;i
      (if (= 111 revcode)(setq revcode 112)) ;;o.. its of to work we go.
      (if (= 91 revcode)(setq revcode 65)) ;;Z -> A. Won't increment 'tens' value
      (if (= 123 revcode)(setq revcode 97)) ;;z -> a Won't increment 'tens' value
      (setq revisionprefix (substr currentrevision 1 (- revlength 1))) ;;first characters of revision
      (setq revletter (strcat revisionprefix (chr revcode)))
    )
  )
));; end of number processing


  (setq entlst (subst (cons 1 revletter) (assoc 1 entlst) entlst))
  (entmod entlst)
  (entupd ent)
  (setvar "CMDECHO" 0)
  (command "regen") ;;in case of nested blocks
  (setvar "CMDECHO" 1)
  (princ)
)

 

Probably better ways to do this, and I have probably copied some of this from other places - but it looks like I haven't referenced where it came from. Noting that this was originally made up to increase the revision number so it has a couple of quirks such as bypassing I and O, but you can just take that out. Should do what you want though

 

Link to comment
Share on other sites

The dumb version. Again I would look for the "-" version 2.

 

(defun c:test ( / num inc ent ett txt)
(setq num (getint "\nNumber of last characters to change "))
(setq inc (getreal "\nNumber to increment by "))
(while (setq ent (entsel "\nPick text "))
(setq entt (entget (car ent)))
(setq txt (cdr (assoc 1 entt)))
(setq tot (strlen txt))
(setq start (substr txt 1 (- tot num)))
(setq end (substr txt (- tot (- num 1))))
(setq end (rtos (+ inc (atoi end)) 2 0))
(setq txt (strcat start end))
(entmod (subst (cons 1 txt) (assoc 1 entt) entt))
)
(princ)
)

 

Link to comment
Share on other sites

On 11/27/2020 at 7:07 AM, BIGAL said:

The dumb version. Again I would look for the "-" version 2.

 


(defun c:test ( / num inc ent ett txt)
(setq num (getint "\nNumber of last characters to change "))
(setq inc (getreal "\nNumber to increment by "))
(while (setq ent (entsel "\nPick text "))
(setq entt (entget (car ent)))
(setq txt (cdr (assoc 1 entt)))
(setq tot (strlen txt))
(setq start (substr txt 1 (- tot num)))
(setq end (substr txt (- tot (- num 1))))
(setq end (rtos (+ inc (atoi end)) 2 0))
(setq txt (strcat start end))
(entmod (subst (cons 1 txt) (assoc 1 entt) entt))
)
(princ)
)

 

Its good Thank you for your support.

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...