;;;Sets case of selected text and of attributes in selected blocks. ;;;Default is all uppercase. ;;; ;;; ;;; AUTHOR: HENRY C. FRANCIS ;;; 425 N. ASHE ST. ;;; SOUTHERN PINES, NC 28387 ;;; ;;; All rights reserved without prejudice. ;;; ;;; Copyright: 7-7-94 ;;; Edited: 9-5-2013 ;;; ;;; 9-5-2013 added MTEXT and MULTILEADERS ;;; added Title case (DEFUN C:CTC (/ tent edtw) (IF ukword NIL (LOAD "UKWORD" "/nFile UKWORD.LSP not loaded! ") ) ;_ end of IF (SETQ which (ukword 1 "Uppercase Lowercase Title" "\nWhich? [Uppercase/Lowercase/Title]" (IF which which "Uppercase") ) ;_ end of ukword ) ;_ end of setq (IF (OR (EQ which "Uppercase")(EQ which "Title")) (SETQ lcflag nil) ) ;if (PROMPT "\nSelect Text: ") (SETQ tset (SSGET '((-4 . "") (-4 . "OR>") ) ) ;_ end of ssget ) ;_ end of setq (IF tset (PROGN (SETQ tsln (SSLENGTH tset)) (SETQ cntr 0) ) ;_ end of progn ) ;_ end of if (WHILE (IF (AND (< cntr tsln) tset) (COND ((EQ (CDR (ASSOC 0 (ENTGET (SSNAME tset cntr)))) "ATTRIB") (SETQ tent (ENTGET (SSNAME tset cntr)))) ((EQ (CDR (ASSOC 0 (ENTGET (SSNAME tset cntr)))) "TEXT") (SETQ tent (ENTGET (SSNAME tset cntr)))) ((EQ (CDR (ASSOC 0 (ENTGET (SSNAME tset cntr)))) "MTEXT") (SETQ tent (ENTGET (SSNAME tset cntr)))) ((EQ (CDR (ASSOC 0 (ENTGET (SSNAME tset cntr)))) "MULTILEADER") (SETQ tent (ENTGET (SSNAME tset cntr)))) ) ;_ end of COND );if (PROGN (SETQ edtw (ENTGET (CDAR tent))) (WHILE (NOT (OR (EQ (CDR (ASSOC 0 edtw)) "TEXT") (EQ (CDR (ASSOC 0 edtw)) "MTEXT") (EQ (CDR (ASSOC 0 edtw)) "MULTILEADER") (EQ (CDR (ASSOC 0 edtw)) "ATTRIB") (EQ (CDR (ASSOC 0 edtw)) "SEQEND") ) ;_ end of or ) ;_ end of not (SETQ edtw (ENTGET (ENTNEXT (CDAR edtw)))) ) ;_ end of while (IF (EQ (CDR (ASSOC 0 edtw)) "SEQEND") (SETQ cntr (1+ cntr)) (PROGN (COND ((EQ (CDR (ASSOC 0 edtw)) "MULTILEADER") (IF (EQ which "Title") (PROGN (titlecase (CDR (ASSOC 304 edtw))) (SETQ tht new_str) ) (SETQ tht (STRCASE (CDR (ASSOC 304 edtw)) lcflag)) ) (SETQ edtw (SUBST (CONS 304 tht) (ASSOC 304 edtw) edtw ) ;_ end of subst ) ;_ end of setq ) ((OR (EQ (CDR (ASSOC 0 edtw)) "TEXT")(EQ (CDR (ASSOC 0 edtw)) "ATTIRB")) (IF (EQ which "Title") (PROGN (titlecase (CDR (ASSOC 1 edtw))) (SETQ tht new_str) ) (SETQ tht (STRCASE (CDR (ASSOC 1 edtw)) lcflag)) ) (SETQ edtw (SUBST (CONS 1 tht) (ASSOC 1 edtw) edtw ) ;_ end of subst ) ;_ end of setq ) ((EQ (CDR (ASSOC 0 edtw)) "MTEXT") (WHILE (OR (SETQ assoc# 1 assoc-part (ASSOC 1 edtw)) (SETQ assoc# 3 assoc-part (ASSOC 3 edtw)) ) (IF (EQ which "Title") (PROGN (titlecase (CDR (ASSOC assoc# edtw))) (SETQ tht new_str) ) (SETQ tht (STRCASE (CDR (ASSOC assoc# edtw)) lcflag)) ) (SETQ edtw (SUBST (CONS assoc# tht) (CAR assoc-part) edtw ) ;_ end of subst ) ;_ end of setq ) ) ) (ENTMOD edtw) (ENTUPD (CDAR edtw)) (IF (EQ (CDR (ASSOC 0 edtw)) "ATTRIB") nil (SETQ cntr (1+ cntr)) ) ;_ end of if ) ;_ end of progn ) ;_ end of if ) ;_ end of progn ) ;_ end of while );DEFUN (DEFUN titlecase (str / ) (IF DOS_STRTOKENS (PROGN (SETQ str_lst (DOS_STRTOKENS str " ")) (SETQ str_word_lst (MAPCAR '(LAMBDA (x) (LIST (STRCASE (SUBSTR x 1 1) nil)(STRCASE (SUBSTR x 2) T))) str_lst)) (SETQ title_word_lst (MAPCAR '(LAMBDA (x) (EVAL (APPEND (LIST 'STRCAT) x (LIST " ")))) str_word_lst)) (SETQ title_word_lst (SUBST (SUBSTR (LAST title_word_lst) 1 (1- (STRLEN (LAST title_word_lst))))(LAST title_word_lst)title_word_lst)) (SETQ new_str (EVAL (CONS 'STRCAT title_word_lst))) ) (ALERT "Requires DOS_LIB function DOS_STRTOKENS not found!") ) (PRINC) ) ;|«Visual LISP© Format Options» (72 2 40 2 T "end of " 60 9 2 0 0 T T nil T) ;*** DO NOT add text below the comment! ***|;