;-------------------------------------------------------------------------------
; Program Name: TAM.lsp [TAM R2]
; Created By:   Terry Miller (Email: terrycadd@yahoo.com)
;               (URL: http://web2.airmail.net/terrycad)
; Date Created: 9-20-05
; Function:     Matches text, mtext and attribute text with the selected text,
;               mtext or attribute text.
;-------------------------------------------------------------------------------
; Revision History
; Rev  By     Date    Description
;-------------------------------------------------------------------------------
; 1    TM   9-20-05   Initial version. Included TM.lsp, Text Match.
; 2    TM   5-9-07    Added Loop to c:TAM to be able to revise more entities.
;-------------------------------------------------------------------------------
; c:TAM - Text and Attribute Match
;-------------------------------------------------------------------------------
(defun c:TAM (/ EntList@ EntName^ EntPick@ EntType$ Loop Match$ Next$ Text$)
  (princ "\nText and Attribute Match")
  (if (setq EntPick@ (nentsel "\nSelect text or attribute text to match: "))
    (progn
      (setq EntName^ (car EntPick@)
            EntList@ (entget EntName^)
            Match$ (if (assoc 1 EntList@) (cdr (assoc 1 EntList@)))
            Loop (if Match$ t nil)
            Next$ ""
      );setq
      (while Loop
        (if (setq EntPick@ (nentsel (strcat "\nSelect " Next$ "text or attribute text to replace with \"" Match$ "\": ")))
          (setq EntName^ (car EntPick@)
                EntList@ (entget EntName^)
                Text$ (if (assoc 1 EntList@) (cdr (assoc 1 EntList@)))
          );setq
          (setq Text$ nil)
        );if
        (if Text$
          (progn
            (setq EntList@ (entmod (subst (cons 1 Match$) (assoc 1 EntList@) EntList@))
                  EntType$ (cdr (assoc 0 EntList@))
            );setq
            (entupd EntName^)
            (if (or (= EntType$ "MTEXT")(= EntType$ "TEXT"))
              (command "REGEN")
            );if
          );progn
          (progn
            (princ "\nNo text or attribute text selected to replace.")
            (setq Loop nil)
          );progn
        );if
        (setq Next$ (if (= Next$ "") "next " ""))
      );while
    );progn
    (princ "\nNo text or attribute text selected to match.")
  );if
  (princ)
);defun c:TAM
;-------------------------------------------------------------------------------
; c:TM - Text Match
;-------------------------------------------------------------------------------
(defun c:TM (/ Cnt# EntList1@ EntName1^ EntList2@ EntName2^ Match$ SS&)
  (princ "\nText Match")
  (princ "\nSelect text or mtext to match")
  (if (setq EntName1^ (car (entsel)))
    (setq EntList1@ (entget EntName1^))
  );if
  (if (or (= (cdr (assoc 0 EntList1@)) "TEXT")(= (cdr (assoc 0 EntList1@)) "MTEXT"))
    (progn
      (setq Match$ (cdr (assoc 1 EntList1@)))
      (princ (strcat "\nSelect text or mtext to replace with " Match$))
      (if (setq SS& (ssget '((-4 . "<OR")(0 . "MTEXT")(0 . "TEXT")(-4 . "OR>"))))
        (progn
          (command "UNDO" "BEGIN")
          (setq Cnt# 0)
          (repeat (sslength SS&)
            (setq EntName2^ (ssname SS& Cnt#)
                  EntList2@ (entget EntName2^)
            );setq
            (setq EntList2@ (subst (cons 1 Match$) (assoc 1 EntList2@) EntList2@))
            (entmod EntList2@)
            (setq Cnt# (1+ Cnt#))
          );repeat
          (command "UNDO" "END")
        );progn
        (princ "\nNo text or mtext selected.")
      );if
    );progn
    (princ "\nNo text or mtext selected.")
  );if
  (princ)
);defun c:TM
;-------------------------------------------------------------------------------
(princ)