   ;  Text CHange - change one or more lines to a single text string.
   ;  Copyright 1990   Rocket Software
   ;  Software that works, for people who'd rather not...
 (defun C:TCH ( / SS CC NUM LLL LLN ZZ TT)
   (setvar "cmdecho" 0)
   (command "undo" "mark")
   (prompt "Please Select Text (you may select several).")
   (setq ss (ssget))                               ; Get text entities
   (if (= "TEXT" (cdr (assoc 0 (entget (ssname SS 0)))))
       (setq tt (strcat "<" (cdr (assoc 1 (entget (ssname ss 0))))
                        "> New text or <Return> to select: "))
       (setq tt "New text or <Return> to select: "))
   (setq cc (getstring t tt))                      ; Get new text string
   (if (= cc "")
       (progn
             (setq nn (entget (car (entsel "Select source text:\n"))))
             (if (= "TEXT" (cdr (assoc 0 nn)))
                 (setq cc (cdr (assoc 1. nn))))))
   (if (/= cc "")
       (progn
       (setq num 0)                                ; Start counter
       (while (ssname ss 0)                        ; while there is a #1 
              (setq lll (ssname ss 0))             ; get 1st entity name
              (setq lln (entget lll))              ; get the whole thing
              (if (= "TEXT" (cdr (assoc 0 lln)))   ; Is entity text? (group 0)
                  (progn
                  (setq num (1+ num))              ; increment counter
                  (setq zz (cdr (assoc 1 lln)))    ; get text string
                  (entmod (subst (cons 1 cc) (cons 1 zz) lln)) ; replace
                  ) )                              ; progn end, if end
                  (ssdel lll ss)                   ; remove from sel. set
       ))                                          ; progn, while end
        (progn
              (grtext)
              (write-line "bLOORT. No changes."))) ; progn, if end
   (if (= 1 num)
       (setq ttx " entity ")
       (setq ttx " lines "))
   (if (or (< 1 num) (= num 1))
       (progn
             (setq s (* (getvar "cdate") 10000000.0))
             (setq nnum (fix (* 10 (- s ( fix s)))))
 (setq mlst (list "sucked into oblivion." "disenfranchised by evil government."
 "rescued from the dark realm of oblivion." "reanimated by electrical science."
 "galvanized into a wierd pseudo-existence." "translated into dog. "
 "wildly mutated by radioactive fallout." "liberated by the yak people."
 "hastily disavowed by the party on ideological grounds."
 "lightly brushed with clarified butter."
 "given new life and new meaning."))
             (setq mm (nth nnum mlst))
             (prompt (strcat (ITOA num) ttx mm))))
   (if (= 3 num)
       (prompt "\nTickle my keys again, baby."))
   (if (= 0 num)
       (progn
       (prompt "I'm sorry but that wasn't text.")
       (prompt "\nYou cretin.")))
   (PRINC))