home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 15 / CD_ASCQ_15_070894.iso / vrac / mar94cad.zip / TIP958.LSP < prev    next >
Lisp/Scheme  |  1994-02-15  |  1KB  |  50 lines
  1. ; TIP958.LSP: CHGCASE.LSP   Change Case of Text   (c)1994, C.D. Iddings
  2.  
  3. (defun C:CHGCASE()
  4.    (setvar "cmdecho" 0)
  5.  
  6.    (defun *error* (msg)
  7.       (princ "error : ")
  8.       (princ msg)
  9.       (terpri)
  10.    )
  11.    (prompt "\nCHANGES CASE TO ALL UPPER OR ALL LOWER    ")
  12.    (setq itm (entsel "\nSelect Text String: ")
  13.       enty (entget (car itm))
  14.    itmid (cdr (assoc 0 (entget (car itm)))))
  15.    (if (/= itmid "TEXT")(chgcase))
  16.    (initget 1 "L U")
  17.    (setq cse (getkword"\nWhat case (U/L)   :  ")
  18.       txtoc (cdr (assoc 1 (entget (car itm))))
  19.       lntxtoc (strlen txtoc)
  20.    o_chr (ascii (substr txtoc 1 1)))
  21.    (cond
  22.       ((= cse "L")
  23.          (if (and (>= o_chr 65)(<= o_chr 90))
  24.       (setq n_chr (chr (+ o_chr 32)))(setq n_chr (chr o_chr))))
  25.       ((= cse "U")
  26.          (if (and (<= o_chr 122)(>= o_chr 97))
  27.       (setq n_chr (chr (- o_chr 32)))(setq n_chr (chr o_chr))))
  28.    )
  29.    (setq n_str n_chr
  30.    cnt 2)
  31.  
  32.    (repeat (- lntxtoc 1)
  33.       (setq o_chr (ascii (substr txtoc cnt 1)))
  34.       (cond
  35.          ((= cse "L")
  36.             (if (and (>= o_chr 65)(<= o_chr 90))
  37.          (setq n_chr (chr (+ o_chr 32)))(setq n_chr (chr o_chr))))
  38.          ((= cse "U")
  39.             (if (and (<= o_chr 122)(>= o_chr 97))
  40.          (setq n_chr (chr (- o_chr 32)))(setq n_chr (chr o_chr))))
  41.       )
  42.       (setq n_str (strcat n_str n_chr)
  43.       cnt (+ cnt 1))
  44.    )
  45.  
  46.    (setq enty (subst (cons 1 n_str)(assoc 1 enty) enty))
  47.    (entmod enty)
  48.    (princ)
  49. );  end chgcase.lsp
  50.