;;; CADALYST 11/08 http://www.cadalyst.com/CADtips
;;; Tip 3024: COUNTER.lsp Replace Text with Incremental Value (c) 2008 Eric Lee Brown

;;;;*********************************************************************
;;; ; BARKER DROTTAR AND ASSOCIATES
;;; ;
;;; ; This routine counts text per user value. it also check value
;;; ; if equal to real number or letter values.
;;; ;
;;; ;
;;; ;
;;; ; Eric Lee Brown Creations
;;; ; ver 1.0 5-1-95
;;; ; updated....
;;; ; 2-27-08
;;; ;********************************************************************
;;; ;********************************************************************
(defun err (s)
(if (= s "Function cancelled")
(princ "\nProgram cancelled: ")
(progn (princ "\nError: ")
(princ s)
(terpri)
)
);if
(resetting)
(princ "SYSTEM VARIABLES have been reset\n")
(princ)
); err
(defun setv (systvar newval)
(setq x (read (strcat systvar "1")))
(set x (getvar systvar))
(setvar systvar newval)
); setv
(defun setting ()
(setq oerr *error*)
(setq *error* err)
(setq curlay (getvar "CLAYER"))
(setq atdia (getvar "ATTDIA"))
(setq cmdech (getvar "CMDECHO"))
(setq oldpw (getvar "plinewid"))
(setv "CMDECHO" 0)
(setvar "ATTDIA" 0)
(setvar "plinewid" 0)
(setv "plinewid" 0)
); end of setting
(defun rsetv (systvar)
(setq x (read (strcat systvar "1")))
(setvar systvar (eval x))
); restv
(defun resetting ()
(rsetv "CMDECHO")
(setq *error* oerr)
(setvar "ATTDIA" atdia)
(setvar "CLAYER" curlay)
(setvar "plinewid" oldpw)
); resetting
;;;************************************************
;;;************************************************
(defun C:CN (/ a1 b1 valuestr asciivalue
numstr numreal c1 d1 doit aa1
bb1 dd1 aaa1 bbb1 ccc1 ddd1
)
(setting)

(setq var (getint "\nEnter variable or....: "))
(if (= var nil)
(setq var 1)
)

(setq xxx 1)
(while xxx
(setq a1 (car (entsel "\nSelect starting text entity: ")))
(if (= a1 nil)
(prompt "Try again!")
)
(if (/= a1 nil)
(setq xxx nil)
)
)

;;; (prompt "\nSelect starter text entity: ")
;;; (setq a1 (ssname (ssget) 0))

;;; (setq a1 (car (entsel)))

(setq b1 (entget a1))
(setq valuestr (cdr (assoc 1 b1)))
(setq asciivalue (ascii valuestr))
(setq numreal (atoi valuestr))

;;;XXXXXXXXXXXXXXXXXXXXXXXX
;;;; if value is a letter
(if (= numreal 0)
(progn

(if (>= asciivalue 65)
(progn
(if (= d1 91)
(progn
(setq d1 65)
)
)

(setq d1 (chr d1))

)
)
)
)
)
(if (>= asciivalue 97)
(progn
(if (= d1 123)
(progn
(setq d1 97)
)
)

(setq d1 (chr d1))

)
)
)
)
)

)
)

;;;XXXXXXXXXXXXXXXXXXXXXXXX
;;;; if value is a number
(if (/= numreal 0)
(progn
(setq c1 (+ var numreal))
(setq d1 (itoa c1))
(defun doit ()
(setq d1 (atoi d1))
(setq d1 (+ var d1))
(setq d1 (itoa d1))
)
)
)

(while a1
(prompt "\nSelect text entity to change: ")
;;; (setq aa1 (ssname (ssget) 0))
(setq aa1 (car (entsel)))
(IF (= aa1 nil)(princ))
(setq bb1 (entget aa1))
(setq aaa1 (cdr bb1))
(setq bbb1 (car aaa1))
(setq ccc1 (cdr bbb1));exact entity type
(if (= ccc1 "TEXT")
(progn
(setq bb1 (subst (cons 1 d1) (assoc 1 bb1) bb1))
(entmod bb1)
(doit)
)
)
(if (= ccc1 "MTEXT")
(progn
(setq bb1 (subst (cons 1 d1) (assoc 1 bb1) bb1))
(entmod bb1)
(doit)
)
)
(if (/= ccc1 "TEXT")
(progn
(if (/= ccc1 "MTEXT")
(progn
(prompt "\nNot a valid TEXT entity, entity value is...")
(princ ccc1)
(prompt "....Try again, please.")
)
)
)
)
)
(princ)
(resetting)
)
(PRINC)
(c:cn)

Advertisements