Jump to content

A LISP THAT INCREASES +1 TO ALL SELECTED TEXTS


egilim123
 Share

Recommended Posts

Hi again , i need a lisp that converts all selected texts to added 1 texts , for example there 5 texts written 1,2,3,4,5 when i use the lisp i select all in the window i use the lisp and they all become 2,3,4,5,6. or maybe texts are for example  T 1,T2,T3,T4,T5 and when i use the lisp they become T2,T3,T4,T5,T6 .  i need this not selecting one by one but at once.

1 (2).jpg

Link to comment
Share on other sites

  • CADTutor changed the title to A LISP THAT INCREASES +1 TO ALL SELECTED TEXTS

Try this, command is txt+.

 

Notes: Will increase A to Z, with Z returning to A (A, - > B -> C.... Z -> A and not say, AA), numbers will follow usual rules and dates in the format dd/mm/yy else will just increase the year

 

Copied from other stuff - if I have missed copying anything let me know

 

 

 

(defun c:txt+ ( / ent entlist ss)

(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 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)
) ; end defun uprev



  (setq ss (ssget '((0 . "*TEXT,ATTRIB"))) )
  (setq acount 0)
  (while (< acount (sslength ss))
    (setq ent (ssname ss acount))
    (setq entlst (entget ent))
    (setq base (cdr (assoc 1 entlst)))
    (setq increments 1)
    (uprev base (ssname ss acount) increments)
    (setq acount (+ acount 1))
  ) ; end while
  (princ)
)

 

Link to comment
Share on other sites

Increment the last character, if the last character is the end limit, also increment the previous character, this for the whole string
Example AZ -> BA or 199 -> 200
Works with TEXT MTEXT MULTILEADER and DIMENSION

 

(vl-load-com)
(defun inc_txt (Txt / Boucle Val_Txt Ascii_Txt Decalage)
  (setq
    Boucle 1
    Val_txt ""
  )
  (while (<= Boucle (strlen Txt))
    (setq Ascii_Txt (vl-string-elt Txt (- (strlen Txt) Boucle)))
    (if (not Decalage)
      (setq Ascii_Txt (1+ Ascii_Txt))
    )
    (if (or (= Ascii_Txt 58) (= Ascii_Txt 91) (= Ascii_Txt 123))
      (setq
        Ascii_Txt
        (cond
          ((= Ascii_Txt 58) 48)
          ((= Ascii_Txt 91) 65)
          ((= Ascii_Txt 123) 97)
        )
        Decalage nil
      )
      (setq Decalage T)
    )
    (setq Val_Txt (strcat (chr Ascii_Txt) Val_Txt))
    (setq Boucle (1+ Boucle))
  )
  (if (not Decalage)
    (setq Val_Txt
      (strcat
        (cond
          ((< Ascii_Txt 58) "0")
          ((< Ascii_Txt 91) "A")
          ((< Ascii_Txt 123) "a")
        )
        Val_Txt
      )
    )
  )
  Val_Txt
)
(defun c:txt_n+1 ( / js AcDoc Space n obj)
  (while
    (not
      (setq js
        (ssget
          (list
            (cons 0 "*TEXT,MULTILEADER,DIMENSION")
            (cons 67 (if (eq (getvar "CVPORT") 2) 0 1))
            (cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB")))
          )
        )
      )
    )
  )
  (setq
    AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
    Space
    (if (eq (getvar "CVPORT") 1)
      (vla-get-PaperSpace AcDoc)
      (vla-get-ModelSpace AcDoc)
    )
    n -1
  )
  (repeat (sslength js)
    (setq obj (vlax-ename->vla-object (ssname js (setq n (1+ n)))))
    (cond
      ((vlax-property-available-p obj 'TextString)
        (vlax-put obj 'TextString (inc_txt (vlax-get obj 'TextString)))
      )
      ((vlax-property-available-p obj 'TextOverride)
        (vlax-put obj 'TextOverride
          (inc_txt
            (if (eq (vlax-get obj 'TextOverride) "")
              (strcat
                (vlax-get obj 'TextPrefix)
                (rtos (vlax-get obj 'Measurement) (vlax-get obj 'UnitsFormat) (vlax-get obj 'PrimaryUnitsPrecision))
                (vlax-get obj 'TextSuffix)
              )
              (vlax-get obj 'TextOverride)
            )
          )
        )
      )
    )
  )
  (prin1)
)

 

Edited by Tsuky
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
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

×
×
  • Create New...