Jump to content

incremental text numbering

pmadhwal7

By pmadhwal7
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

pmadhwal7 Rising Star

pmadhwal7

Posted
Posted

Hi,

Is there any lisp that marks incremental text numbering by selecting the previous number and automatically changing the next number if my previous number is 1 and i select the next text and it will change it in 2

shot.dwg

Link to comment
Share on other sites
exceed Rising Star

exceed

Posted
Posted (edited) 
; command = w for 1 digit
(defun c:w ( / n e nn old new )
     (setq n (getint "\n input start number : "))
     (while (setq e (car(entsel "\n select text you want to change : ")))
            (setq e (entget e))
            (setq nn (itoa n))
            (cond ((= 1 (strlen nn)) (setq nn (strcat "" nn)))
            )
            (setq old (assoc 1 e)
                  new (cons 1 nn)
            )
            (setq e (subst new old e))
            (entmod e)
            (setq n (1+ n))
    )
)

; command = ww for 2 digit
(defun c:ww ( / n e nn old new )
     (setq n (getint "\n input start number : "))
     (while (setq e (car(entsel "\n select text you want to change : ")))
            (setq e (entget e))
            (setq nn (itoa n))
            (cond ((= 1 (strlen nn)) (setq nn (strcat "0" nn)))
                  ((= 2 (strlen nn)) (setq nn (strcat "" nn)))
            )
            (setq old (assoc 1 e)
                  new (cons 1 nn)
            )
            (setq e (subst new old e))
            (entmod e)
            (setq n (1+ n))
    )
)

; command = www for 3 digit
(defun c:www ( / n e nn old new )
     (setq n (getint "\n input start number : "))
     (while (setq e (car(entsel "\n select text you want to change : ")))
            (setq e (entget e))
            (setq nn (itoa n))
            (cond ((= 1 (strlen nn)) (setq nn (strcat "00" nn)))
                  ((= 2 (strlen nn)) (setq nn (strcat "0" nn)))
                  ((= 3 (strlen nn)) (setq nn (strcat "" nn)))
            )
            (setq old (assoc 1 e)
                  new (cons 1 nn)
            )
            (setq e (subst new old e))
            (entmod e)
            (setq n (1+ n))
    )
)

; command = wwww for 4 digit
(defun c:wwww ( / n e nn old new )
     (setq n (getint "\n input start number : "))
     (while (setq e (car(entsel "\n select text you want to change : ")))
            (setq e (entget e))
            (setq nn (itoa n))
            (cond ((= 1 (strlen nn)) (setq nn (strcat "000" nn)))
                  ((= 2 (strlen nn)) (setq nn (strcat "00" nn)))
                  ((= 3 (strlen nn)) (setq nn (strcat "0" nn)))
                  ((= 4 (strlen nn)) (setq nn (strcat " " nn)))
            )
            (setq old (assoc 1 e)
                  new (cons 1 nn)
            )
            (setq e (subst new old e))
            (entmod e)
            (setq n (1+ n))
    )
)

 

like this? or another?

If you input command "w", then enter the start number. (in example 1)

and then select the text, it will changes from 1, then next selected text will change to 2,3,4,5 in that order. 

If the starting number is entered as 100, the texts selected as 100,101,102 are changed.

 

And the code below is what I changed to select multiple texts at once. It can't be used for diagonal lines like your sample drawing, but only for tables. 

; Changes multiple texts to continuous numbers. (top left to bottom right) - 2022.05.06 exceed
; command list : MW, MWW, MWWW, MWWWW
; number of W is number of digit, in example 8 ~ 11
; MW = 8,9,10,11
; MWW = 08,09,10,11
; MWWW = 008,009,010,011
; MWWWW = 0008,0009,0010,0011
; There is no problem in the case of 1 vertical line and 1 horizontal line.
; but, if they are both horizontal and vertical, if they overlap, or if the coordinates are slightly different up and down, 
; the order may be shuffled.


(vl-load-com)
; multiple w, from Left-top ~ Right-bottom.
(defun c:MW ( / *error* n gap ss1 ss1count ss1index ss1y ss1list ss1stacklist ss1ent ss1x ss1sll ss1slindex nn ss1obj )
  (setvar 'cmdecho 0)
  (LM:startundo (LM:acdoc))
  ;error control
    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (setvar 'cmdecho 1)
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (princ)
    )
  
  (setq n (getint "\n input start number (no input default value is 1) : "))
  (if (= n nil) (setq n 1))
  (setq gap (getint "\n input increse number (no input default value is 1) : "))
  (if (= gap nil) (setq gap 1))
  (princ "\n select all texts you want to change (order is top-left to bottom-right)")
  (setq ss1 (ssget (list (cons 0 "*TEXT"))))
  (setq ss1count (sslength ss1))
  (setq ss1index 0)
  (setq ss1y 0)
  (setq ss1list nil)
  (setq ss1stacklist nil)

  ;get list of original texts ( y-coordinate textcontents )
  (repeat ss1count
    (setq ss1ent (entget (ssname ss1 ss1index)))
    (setq ss1y (atoi (rtos (* (nth 2 (assoc 10 ss1ent)) -1) 2 2 ) ) )   ; * -1 for reverse y coordinates (for sorting)
    (setq ss1x (atoi (rtos (nth 1 (assoc 10 ss1ent)) 2 2) ) )
    (setq ss1list (list ss1y ss1index ss1x))
    (setq ss1stacklist (cons ss1list ss1stacklist))
    (setq ss1index (+ ss1index 1))
  );end repeat

  ;(princ "\n original list : ")
  ;(princ ss1stacklist)

  ;sort original list
  (setq ss1stacklist (vl-sort ss1stacklist
                              (function
                                      (lambda (x1 x2)(< (car x1) (car x2)))
                              )
                        )
  )

  ;(princ "\n sorted1 original list : ")
  ;(princ ss1stacklist)

(defun mysort ( l )
   (vl-sort l
      '(lambda ( a b )
           (if (eq (car a) (car  b))
               (< (caddr a) (caddr b))
               (< (car a) (car b)) ;(< (vl-prin1-to-string (car a)) (vl-prin1-to-string (car b)))
           )
       )
   )
)

(setq ss1stacklist (mysort ss1stacklist))
(setq ss1sll (length ss1stacklist))
(setq ss1slindex 0)

(repeat ss1sll
  (setq nn (itoa n))
  (cond 
    ((= 1 (strlen nn)) (setq nn (strcat "" nn)))
  )
  (setq ss1obj (vlax-ename->vla-object (ssname ss1 (cadr (nth ss1slindex ss1stacklist)) )))
  (vla-put-textstring ss1obj nn)
  (setq n (+ n gap))
  (setq ss1slindex (+ ss1slindex 1))
)
  
 
  (setvar 'cmdecho 1)
  (LM:endundo (LM:acdoc))
(princ)
)

; multiple ww, from Left-top ~ Right-bottom.
(defun c:MWW ( / *error* n gap ss1 ss1count ss1index ss1y ss1list ss1stacklist ss1ent ss1x ss1sll ss1slindex nn ss1obj )
  (setvar 'cmdecho 0)
  (LM:startundo (LM:acdoc))
  ;error control
    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (setvar 'cmdecho 1)
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (princ)
    )

  (setq n (getint "\n input start number (no input default value is 1) : "))
  (if (= n nil) (setq n 1))
  (setq gap (getint "\n input increse number (no input default value is 1) : "))
  (if (= gap nil) (setq gap 1))
  (princ "\n select all texts you want to change (order is top-left to bottom-right)")
  (setq ss1 (ssget (list (cons 0 "*TEXT"))))
  (setq ss1count (sslength ss1))
  (setq ss1index 0)
  (setq ss1y 0)
  (setq ss1list nil)
  (setq ss1stacklist nil)

  ;get list of original texts ( y-coordinate textcontents )
  (repeat ss1count
    (setq ss1ent (entget (ssname ss1 ss1index)))
    (setq ss1y (atoi (rtos (* (nth 2 (assoc 10 ss1ent)) -1) 2 2 ) ) )   ; * -1 for reverse y coordinates (for sorting)
    (setq ss1x (atoi (rtos (nth 1 (assoc 10 ss1ent)) 2 2) ) )
    (setq ss1list (list ss1y ss1index ss1x))
    (setq ss1stacklist (cons ss1list ss1stacklist))
    (setq ss1index (+ ss1index 1))
  );end repeat

  ;(princ "\n original list : ")
  ;(princ ss1stacklist)

  ;sort original list
  (setq ss1stacklist (vl-sort ss1stacklist
                              (function
                                      (lambda (x1 x2)(< (car x1) (car x2)))
                              )
                        )
  )

  ;(princ "\n sorted1 original list : ")
  ;(princ ss1stacklist)

(defun mysort ( l )
   (vl-sort l
      '(lambda ( a b )
           (if (eq (car a) (car  b))
               (< (caddr a) (caddr b))
               (< (car a) (car b)) ;(< (vl-prin1-to-string (car a)) (vl-prin1-to-string (car b)))
           )
       )
   )
)

(setq ss1stacklist (mysort ss1stacklist))
(setq ss1sll (length ss1stacklist))
(setq ss1slindex 0)

(repeat ss1sll
  (setq nn (itoa n))
            (cond 
                  ((= 1 (strlen nn)) (setq nn (strcat "0" nn)))
                  ((= 2 (strlen nn)) (setq nn (strcat "" nn)))
            )
  (setq ss1obj (vlax-ename->vla-object (ssname ss1 (cadr (nth ss1slindex ss1stacklist)) )))
  (vla-put-textstring ss1obj nn)
  (setq n (+ n gap))
  (setq ss1slindex (+ ss1slindex 1))
)
  
 
  (setvar 'cmdecho 1)
  (LM:endundo (LM:acdoc))
(princ)
)


; multiple www, from Left-top ~ Right-bottom.
(defun c:MWWW ( / *error* n gap ss1 ss1count ss1index ss1y ss1list ss1stacklist ss1ent ss1x ss1sll ss1slindex nn ss1obj )
  (setvar 'cmdecho 0)
  (LM:startundo (LM:acdoc))
  ;error control
    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (setvar 'cmdecho 1)
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (princ)
    )

  (setq n (getint "\n input start number (no input default value is 1) : "))
  (if (= n nil) (setq n 1))
  (setq gap (getint "\n input increse number (no input default value is 1) : "))
  (if (= gap nil) (setq gap 1))
  (princ "\n select all texts you want to change (order is top-left to bottom-right)")
  (setq ss1 (ssget (list (cons 0 "*TEXT"))))
  (setq ss1count (sslength ss1))
  (setq ss1index 0)
  (setq ss1y 0)
  (setq ss1list nil)
  (setq ss1stacklist nil)

  ;get list of original texts ( y-coordinate textcontents )
  (repeat ss1count
    (setq ss1ent (entget (ssname ss1 ss1index)))
    (setq ss1y (atoi (rtos (* (nth 2 (assoc 10 ss1ent)) -1) 2 2 ) ) )   ; * -1 for reverse y coordinates (for sorting)
    (setq ss1x (atoi (rtos (nth 1 (assoc 10 ss1ent)) 2 2) ) )
    (setq ss1list (list ss1y ss1index ss1x))
    (setq ss1stacklist (cons ss1list ss1stacklist))
    (setq ss1index (+ ss1index 1))
  );end repeat

  ;(princ "\n original list : ")
  ;(princ ss1stacklist)

  ;sort original list
  (setq ss1stacklist (vl-sort ss1stacklist
                              (function
                                      (lambda (x1 x2)(< (car x1) (car x2)))
                              )
                        )
  )

  ;(princ "\n sorted1 original list : ")
  ;(princ ss1stacklist)

(defun mysort ( l )
   (vl-sort l
      '(lambda ( a b )
           (if (eq (car a) (car  b))
               (< (caddr a) (caddr b))
               (< (car a) (car b)) ;(< (vl-prin1-to-string (car a)) (vl-prin1-to-string (car b)))
           )
       )
   )
)

(setq ss1stacklist (mysort ss1stacklist))
(setq ss1sll (length ss1stacklist))
(setq ss1slindex 0)

(repeat ss1sll
  (setq nn (itoa n))
            (cond 
                  ((= 1 (strlen nn)) (setq nn (strcat "00" nn)))
                  ((= 2 (strlen nn)) (setq nn (strcat "0" nn)))
                  ((= 3 (strlen nn)) (setq nn (strcat "" nn)))
            )
  (setq ss1obj (vlax-ename->vla-object (ssname ss1 (cadr (nth ss1slindex ss1stacklist)) )))
  (vla-put-textstring ss1obj nn)
  (setq n (+ n gap))
  (setq ss1slindex (+ ss1slindex 1))
)
  
 
  (setvar 'cmdecho 1)
  (LM:endundo (LM:acdoc))
(princ)
)


; multiple wwww, from Left-top ~ Right-bottom.
(defun c:MWWWW ( / *error* n gap ss1 ss1count ss1index ss1y ss1list ss1stacklist ss1ent ss1x ss1sll ss1slindex nn ss1obj )
  (setvar 'cmdecho 0)
  (LM:startundo (LM:acdoc))
  ;error control
    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (setvar 'cmdecho 1)
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (princ)
    )

  (setq n (getint "\n input start number (no input default value is 1) : "))
  (if (= n nil) (setq n 1))
  (setq gap (getint "\n input increse number (no input default value is 1) : "))
  (if (= gap nil) (setq gap 1))
  (princ "\n select all texts you want to change (order is top-left to bottom-right)")
  (setq ss1 (ssget (list (cons 0 "*TEXT"))))
  (setq ss1count (sslength ss1))
  (setq ss1index 0)
  (setq ss1y 0)
  (setq ss1list nil)
  (setq ss1stacklist nil)

  ;get list of original texts ( y-coordinate textcontents )
  (repeat ss1count
    (setq ss1ent (entget (ssname ss1 ss1index)))
    (setq ss1y (atoi (rtos (* (nth 2 (assoc 10 ss1ent)) -1) 2 2 ) ) )   ; * -1 for reverse y coordinates (for sorting)
    (setq ss1x (atoi (rtos (nth 1 (assoc 10 ss1ent)) 2 2) ) )
    (setq ss1list (list ss1y ss1index ss1x))
    (setq ss1stacklist (cons ss1list ss1stacklist))
    (setq ss1index (+ ss1index 1))
  );end repeat

  ;(princ "\n original list : ")
  ;(princ ss1stacklist)

  ;sort original list
  (setq ss1stacklist (vl-sort ss1stacklist
                              (function
                                      (lambda (x1 x2)(< (car x1) (car x2)))
                              )
                        )
  )

  ;(princ "\n sorted1 original list : ")
  ;(princ ss1stacklist)

(defun mysort ( l )
   (vl-sort l
      '(lambda ( a b )
           (if (eq (car a) (car  b))
               (< (caddr a) (caddr b))
               (< (car a) (car b)) ;(< (vl-prin1-to-string (car a)) (vl-prin1-to-string (car b)))
           )
       )
   )
)

(setq ss1stacklist (mysort ss1stacklist))
(setq ss1sll (length ss1stacklist))
(setq ss1slindex 0)

(repeat ss1sll
  (setq nn (itoa n))
            (cond 
                  ((= 1 (strlen nn)) (setq nn (strcat "000" nn)))
                  ((= 2 (strlen nn)) (setq nn (strcat "00" nn)))
                  ((= 3 (strlen nn)) (setq nn (strcat "0" nn)))
                  ((= 4 (strlen nn)) (setq nn (strcat "" nn)))
            )
  (setq ss1obj (vlax-ename->vla-object (ssname ss1 (cadr (nth ss1slindex ss1stacklist)) )))
  (vla-put-textstring ss1obj nn)
  (setq n (+ n gap))
  (setq ss1slindex (+ ss1slindex 1))
)
  
 
  (setvar 'cmdecho 1)
  (LM:endundo (LM:acdoc))
(princ)
)



;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)


;; Start Undo  -  Lee Mac
;; Opens an Undo Group.

(defun LM:startundo ( doc )
    (LM:endundo doc)
    (vla-startundomark doc)
)

;; End Undo  -  Lee Mac
;; Closes an Undo Group.

(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)
    )
)

mw.gif

 

Edited by exceed
  • Like 1
Link to comment
Share on other sites
Steven P Grand Master

Steven P

Posted
Posted

This is what I use, a bit long with the code, command is CTX+ (this started from Lee Macs CTX code and then modified, and modified again to loose all his clever stuff and become quite basic coding).

 

It grabs the starting text value from the drawing unlike above where you can enter it (maybe a tweak for the future, good idea), and you can -currently- specify the increments from -4 to +4 (should be clear in the code where to change that). It will then incrementally updated texts you select

 

It will also increment with alphanumerical text (example '1-A' till copy to '1-B', '1-C' and so on) and also dates in the format dd/mm/yy (yyyy) and dd.mm.yy (or dd.mm.yyyy)(dates because I use the increment part for other things).

 

There isn't much error checking and escapes, I am due to rewrite this all again sometime with some other things and errors are to be added then,..... just need the time.

 

From your example I think for mine and most others you would need to split say "Shot Length=145 Duct Length=148" into 2 separate texts to copy and increment the 145 and 148, mine will just go to "Shot Length=145 Duct Length=149" and so on
 

 

  

(defun c:ctx+ ( / increment )
  (if (= increments nil) (setq increments 1))
  (setq endloop "No")
  (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") )
      (  (null sel)(setq endloop "Yes") )
      (  (= "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 endloop "No")


    (setq ent (car sel))
    (setq entlst (entget ent))
    (setq base (cdr (assoc 1 entlst)))
    (if (= increment nil) (setq increment increments))

  (while
    (while (= endloop "No")
      (setq sel (nentsel "\nSelect Text to Replace and Increment: ") )
      (cond
        (  (null sel)(setq endloop "Yes") )
;;        (  (null sel)(princ "\nMissed! Select text, enter increment or press <escape> or 'E'\n") )
        (  (= "Exit" sel)(princ)(exit) )
        (  (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
    (uprev base sel increment)
    (setq endloop "No")
    (setq increment (+ increment 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)
)

 

Link to comment
Share on other sites
pmadhwal7 Rising Star

pmadhwal7

Posted
  • Author
Posted
On 5/7/2022 at 4:13 AM, BIGAL said:

Multi getvals and multi radio buttons.lsp are here in Cadtutor download. 

image.thumb.png.5d141381b3f78db01fb498bbfbdf6c3a.png

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.

×
 Share
Go to topic listing
×
×
  • Create New...