;;;Adds words used in a drawing to Abbr.txt in the drawing's folder or
;;;creates Abbr.txt if it does not exist. Does not make duplicate entries.
;;;Run in every drawing to list all abbreviations and other words used
;;;across a project. Cannot recognize words in Xrefs or nested blocks.
;;;
;;;>	Author:	Henry C. Francis
;;;>		425 N. Ashe St.
;;;>		Southern Pines, NC 28387
;;;>		http://paracadd.com
;;;>		All rights reserved.
;;;
;;;>		COPYRIGHT: 
;;;>		   EDITED: 05-25-2006
;;;
(DEFUN c:abbrlst (/ abbr_lst)
  (SETQ ss (SSGET "x"
                  '((-4 . "<OR")
                    (0 . "TEXT")
                    (0 . "INSERT")
                    (0 . "ATTDEF")
                    (0 . "MTEXT")
                    (-4 . "<AND")
                    (0 . "DIMENSION")
                    (1 . "*")
                    (-4 . "AND>")
                    (-4 . "<AND")
                    (0 . "LEADER")
                    (-4 . "<OR")
                    (73 . 1)
                    (73 . 0)
                    (-4 . "OR>")
                    (-4 . "AND>")
                    (-4 . "OR>")
                   )
           ) ;_ end of ssget
  ) ;_ end of setq
  (SETQ sslen (SSLENGTH ss))
  (SETQ count 0)
  (SETQ earall (ukword 1
                       "Add Create"
                       "<A>dd words to global list or <C>reate/replace word list for this drawing?"
                       (IF earall
                         earall
                         "Create"
                       ) ;_ end of IF
               ) ;_ end of ukword
  ) ;_ end of SETQ
  (IF (EQ earall "Create")
    NIL
    (IF (SETQ abbr_fil (FINDFILE (STRCAT (GETVAR "dwgprefix") "allword.txt")))
      (PROGN (SETQ abbr_in (OPEN (STRCAT (GETVAR "dwgprefix") "allword.txt") "r"))
             (WHILE (SETQ rd_lin (READ-LINE abbr_in))
               (IF abbr_lst
                 (SETQ abbr_lst (APPEND abbr_lst (LIST rd_lin)))
                 (SETQ abbr_lst (LIST rd_lin))
               ) ;_ end of if
             ) ;_ end of while
             (CLOSE abbr_in)
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of IF
  (PRINC (STRCAT "\n" (ITOA sslen) " text objects will be examined.\n"))
  (PRINC)
  (WHILE (< count sslen)
    (SETQ curentnam (SSNAME ss count)
          curentdef (ENTGET curentnam)
          txt_item  NIL
    ) ;_ end of SETQ
    (COND ((EQ (CDR (ASSOC 0 curentdef)) "INSERT")
           (SETQ blkent (TBLSEARCH "BLOCK" (CDR (ASSOC 2 curentdef))))
           (IF (>= (CDR (ASSOC 70 blkent)) 4)
             (SETQ skip_ent T)
             (WHILE (AND curentdef (/= (CDR (ASSOC 0 curentdef)) "SEQEND"))
;;;               (PRINC "\n")
;;;               (PRINC (CDR (ASSOC 0 curentdef)))
               (COND ((OR (EQ (CDR (ASSOC 0 curentdef)) "TEXT")
                          (EQ (CDR (ASSOC 0 curentdef)) "ATTRIB")
                          (AND (EQ (CDR (ASSOC 0 curentdef)) "DIMENSION") (ASSOC 1 curentdef))
                      ) ;_ end of OR
                      (IF txt_item
                        (SETQ txt_item (STRCAT txt_item " " (CDR (ASSOC 1 curentdef))))
                        (SETQ txt_item (CDR (ASSOC 1 curentdef)))
                      ) ;_ end of IF
                     )
                     ((EQ (CDR (ASSOC 0 curentdef)) "MTEXT") (mtxtsubr))
               ) ;_ end of COND
               (SETQ nxtentnam (ENTNEXT (CDR (ASSOC -1 curentdef))))
               (IF nxtentnam
                 (SETQ curentdef (ENTGET nxtentnam))
                 (SETQ curentdef NIL)
               ) ;_ end of IF
             ) ;_ end of WHILE
           ) ;_ end of IF
          )
          ((EQ (CDR (ASSOC 0 curentdef)) "MTEXT") (mtxtsubr))
          ((EQ (CDR (ASSOC 0 curentdef)) "LEADER")
           (SETQ curentdef (ENTGET (CDR (ASSOC 340 curentdef))))
           (mtxtsubr)
          )
          (T (SETQ txt_item (CDR (ASSOC 1 curentdef))))
    ) ;_ end of COND
    (IF (OR skip_ent (NOT txt_item))
      (SETQ skip_ent NIL)
      (PROGN
        (IF (WCMATCH txt_item "*B.D.*")
          (SETQ bdlst (APPEND bdlst (LIST curentnam)))
        ) ;_ end of IF
        (SETQ txtlen (STRLEN txt_item))
        (SETQ charcnt 1
              begincnt 1
        ) ;_ end of setq
        (WHILE (<= begincnt txtlen)
          (WHILE (AND (/= (SUBSTR txt_item charcnt 1) " ") (/= (SUBSTR txt_item charcnt 1) "=") (<= charcnt txtlen))
            (SETQ charcnt (1+ charcnt))
          ) ;_ end of while
          (SETQ txt_part (SUBSTR txt_item begincnt (- (1+ charcnt) begincnt))
                charcnt  (1+ charcnt)
                begincnt charcnt
          ) ;_ end of setq
          (WHILE (AND (> (STRLEN txt_part) 1)
                      (OR (EQ (SUBSTR txt_part (STRLEN txt_part)) " ")
                          (EQ (SUBSTR txt_part (STRLEN txt_part)) ",")
                          (EQ (SUBSTR txt_part (STRLEN txt_part)) ":")
                          (EQ (SUBSTR txt_part (STRLEN txt_part)) ";")
                          (EQ (SUBSTR txt_part (STRLEN txt_part)) "=")
                          (AND (EQ (SUBSTR txt_part (STRLEN txt_part)) ".") (NOT (WCMATCH txt_part "*.?*")))
                          (AND (EQ (SUBSTR txt_part (STRLEN txt_part)) ")") (NOT (WCMATCH txt_part "*(*")))
                      ) ;_ end of OR
                 ) ;_ end of AND
            (SETQ txt_part (SUBSTR txt_part 1 (1- (STRLEN txt_part))))
          ) ;_ end of WHILE
          (WHILE (AND (> (STRLEN txt_part) 1)
                      (OR (EQ (SUBSTR txt_part 1 1) " ")
                          (EQ (SUBSTR txt_part 1 1) ",")
                          (EQ (SUBSTR txt_part 1 1) ":")
                          (EQ (SUBSTR txt_part 1 1) ";")
                          (EQ (SUBSTR txt_part 1 1) "=")
                          (EQ (SUBSTR txt_part 1 1) ".")
                          (AND (EQ (SUBSTR txt_part 1 1) "(") (NOT (WCMATCH txt_part "*(*")))
                      ) ;_ end of OR
                 ) ;_ end of AND
            (SETQ txt_part (SUBSTR txt_part 2))
          ) ;_ end of WHILE
;;;          (IF (WCMATCH txt_part "*Av*")
;;;            (progn
;;;              (princ "\n\t\t")
;;;              (princ txt_part)
;;;              (princ "\n\t\t")
;;;              (princ curentdef)
;;;              (princ)
;;;            )
;;;          )
          (IF abbr_lst
            (IF (OR (MEMBER txt_part abbr_lst) (MEMBER (STRCAT txt_part " ") abbr_lst) (WCMATCH txt_part "*#*"))
              nil ;          (progn(princ begincnt)(princ " ")(princ charcnt)(princ " ")(princ (strcat txt_part "\n")))
              (SETQ abbr_lst (APPEND abbr_lst (LIST txt_part)))
            )  ;          (progn(princ begincnt)(princ " ")(princ charcnt)(princ " ")(princ (strcat txt_part "\n")))
            (SETQ abbr_lst (LIST txt_part))
          ) ;_ end of if
        ) ;_ end of while
      ) ;_ end of PROGN
    ) ;_ end of IF
    (SETQ count    (1+ count)
          begincnt 1
          charcnt  1
    ) ;_ end of setq
;;;    (IF (EQ (REM count 20.0) 0.0)
;;;      (PROGN
        (PRINC (STRCAT "\010\010\010\010\010\010\010\010\010" (ITOA count)))
        (PRINC)
;;;      )
;;;    )
  ) ;_ end of while
  (SETQ abbr_lst (ACAD_STRLSORT abbr_lst))
  (SETQ abbr_out (OPEN (STRCAT (GETVAR "dwgprefix")
                               (IF (EQ earall "Create")
                                 (SUBSTR (GETVAR "dwgname") 1 (- (STRLEN (GETVAR "dwgname")) 4))
                                 ""
                               ) ;_ end of IF
                               "allword.txt"
                       ) ;_ end of STRCAT
                       "w"
                 ) ;_ end of OPEN
  ) ;_ end of SETQ
  (FOREACH n abbr_lst (PRINC (STRCAT n "\n") abbr_out))
  (CLOSE abbr_out)
) ;_ end of defun
(DEFUN mtxtsubr ()
  (IF txt_item
    (SETQ txt_item (STRCAT txt_item " " (CDR (ASSOC 1 curentdef))))
    (SETQ txt_item (CDR (ASSOC 1 curentdef)))
  ) ;_ end of IF
;;;  (SETQ keypt (CDR (ASSOC 10 curentdef)))
  (WHILE (SETQ nxt_txt (ASSOC 3 curentdef))
    (SETQ txt_item  (STRCAT txt_item " " (CDR nxt_txt))
          curentdef (CDR (MEMBER nxt_txt curentdef))
    ) ;_ end of SETQ
  ) ;_ end of WHILE
  (PRINC)
) ;_ end of defun
(DEFUN abbrlst (earall / abbr_lst)
  (SETQ ss (SSGET "x"
                  '((-4 . "<OR")
                    (0 . "TEXT")
                    (0 . "INSERT")
                    (0 . "ATTDEF")
                    (0 . "MTEXT")
                    (-4 . "<AND")
                    (0 . "DIMENSION")
                    (1 . "*")
                    (-4 . "AND>")
                    (-4 . "<AND")
                    (0 . "LEADER")
                    (-4 . "<OR")
                    (73 . 1)
                    (73 . 0)
                    (-4 . "OR>")
                    (-4 . "AND>")
                    (-4 . "OR>")
                   )
           ) ;_ end of ssget
  ) ;_ end of setq
  (SETQ sslen (SSLENGTH ss))
  (SETQ count 0)
;;;  (SETQ earall
;;;               (ukword 1
;;;                       "Add Create"
;;;                       "<A>dd words to global list or <C>reate/replace word list for this drawing?"
;;;                       (IF earall
;;;                         earall
;;;                         "Create"
;;;                       ) ;_ end of IF
;;;               )
;;;  ) ;_ end of SETQ
  (IF (EQ earall "Create")
    NIL
    (IF (SETQ abbr_fil (FINDFILE (STRCAT (GETVAR "dwgprefix") "allword.txt")))
      (PROGN (SETQ abbr_in (OPEN (STRCAT (GETVAR "dwgprefix") "allword.txt") "r"))
             (WHILE (SETQ rd_lin (READ-LINE abbr_in))
               (IF abbr_lst
                 (SETQ abbr_lst (APPEND abbr_lst (LIST rd_lin)))
                 (SETQ abbr_lst (LIST rd_lin))
               ) ;_ end of if
             ) ;_ end of while
             (CLOSE abbr_in)
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of IF
  (WHILE (< count sslen)
    (SETQ curentnam (SSNAME ss count)
          curentdef (ENTGET curentnam)
          txt_item  NIL
    ) ;_ end of SETQ
    (COND ((EQ (CDR (ASSOC 0 curentdef)) "INSERT")
           (SETQ blkent (TBLSEARCH "BLOCK" (CDR (ASSOC 2 curentdef))))
           (IF (>= (CDR (ASSOC 70 blkent)) 4)
             (SETQ skip_ent T)
             (WHILE (AND curentdef (/= (CDR (ASSOC 0 curentdef)) "SEQEND"))
;;;               (PRINC "\n")
;;;               (PRINC (CDR (ASSOC 0 curentdef)))
               (COND ((OR (EQ (CDR (ASSOC 0 curentdef)) "TEXT")
                          (EQ (CDR (ASSOC 0 curentdef)) "ATTRIB")
                          (AND (EQ (CDR (ASSOC 0 curentdef)) "DIMENSION") (ASSOC 1 curentdef))
                      ) ;_ end of OR
                      (IF txt_item
                        (SETQ txt_item (STRCAT txt_item " " (CDR (ASSOC 1 curentdef))))
                        (SETQ txt_item (CDR (ASSOC 1 curentdef)))
                      ) ;_ end of IF
                     )
                     ((EQ (CDR (ASSOC 0 curentdef)) "MTEXT") (mtxtsubr))
               ) ;_ end of COND
               (SETQ nxtentnam (ENTNEXT (CDR (ASSOC -1 curentdef))))
               (IF nxtentnam
                 (SETQ curentdef (ENTGET nxtentnam))
                 (SETQ curentdef NIL)
               ) ;_ end of IF
             ) ;_ end of WHILE
           ) ;_ end of IF
          )
          ((EQ (CDR (ASSOC 0 curentdef)) "MTEXT") (mtxtsubr))
          ((EQ (CDR (ASSOC 0 curentdef)) "LEADER")
           (SETQ curentdef (ENTGET (CDR (ASSOC 340 curentdef))))
           (mtxtsubr)
          )
          (T (SETQ txt_item (CDR (ASSOC 1 curentdef))))
    ) ;_ end of COND
    (IF (OR skip_ent (NOT txt_item))
      (SETQ skip_ent NIL)
      (PROGN
        (IF (WCMATCH txt_item "*B.D.*")
          (SETQ bdlst (APPEND bdlst (LIST curentnam)))
        ) ;_ end of IF
        (SETQ txtlen (STRLEN txt_item))
        (SETQ charcnt 1
              begincnt 1
        ) ;_ end of setq
        (WHILE (<= begincnt txtlen)
          (WHILE (AND (/= (SUBSTR txt_item charcnt 1) " ") (/= (SUBSTR txt_item charcnt 1) "=") (<= charcnt txtlen))
            (SETQ charcnt (1+ charcnt))
          ) ;_ end of while
          (SETQ txt_part (SUBSTR txt_item begincnt (- (1+ charcnt) begincnt))
                charcnt  (1+ charcnt)
                begincnt charcnt
          ) ;_ end of setq
          (WHILE (AND (> (STRLEN txt_part) 1)
                      (OR (EQ (SUBSTR txt_part (STRLEN txt_part)) " ")
                          (EQ (SUBSTR txt_part (STRLEN txt_part)) ",")
                          (EQ (SUBSTR txt_part (STRLEN txt_part)) ":")
                          (EQ (SUBSTR txt_part (STRLEN txt_part)) ";")
                          (EQ (SUBSTR txt_part (STRLEN txt_part)) "=")
                          (AND (EQ (SUBSTR txt_part (STRLEN txt_part)) ".") (NOT (WCMATCH txt_part "*.?*"))(NOT (WCMATCH txt_part "*. *")))
                          (AND (EQ (SUBSTR txt_part (STRLEN txt_part)) ")") (NOT (WCMATCH txt_part "*(*")))
                      ) ;_ end of OR
                 ) ;_ end of AND
            (SETQ txt_part (SUBSTR txt_part 1 (1- (STRLEN txt_part))))
          ) ;_ end of WHILE
          (WHILE (AND (> (STRLEN txt_part) 1)
                      (OR (EQ (SUBSTR txt_part 1 1) " ")
                          (EQ (SUBSTR txt_part 1 1) ",")
                          (EQ (SUBSTR txt_part 1 1) ":")
                          (EQ (SUBSTR txt_part 1 1) ";")
                          (EQ (SUBSTR txt_part 1 1) "=")
                          (EQ (SUBSTR txt_part 1 1) ".")
                          (AND (EQ (SUBSTR txt_part 1 1) "(") (NOT (WCMATCH txt_part "*(*")))
                      ) ;_ end of OR
                 ) ;_ end of AND
            (SETQ txt_part (SUBSTR txt_part 2))
          ) ;_ end of WHILE
;;;            (princ "\n\t\t")
;;;            (princ txt_part)
          (IF abbr_lst
            (IF (OR (MEMBER txt_part abbr_lst) (MEMBER (STRCAT txt_part " ") abbr_lst) (WCMATCH txt_part "*#*"))
              nil ;          (progn(princ begincnt)(princ " ")(princ charcnt)(princ " ")(princ (strcat txt_part "\n")))
              (SETQ abbr_lst (APPEND abbr_lst (LIST txt_part)))
            )  ;          (progn(princ begincnt)(princ " ")(princ charcnt)(princ " ")(princ (strcat txt_part "\n")))
            (SETQ abbr_lst (LIST txt_part))
          ) ;_ end of if
        ) ;_ end of while
      ) ;_ end of PROGN
    ) ;_ end of IF
    (SETQ count    (1+ count)
          begincnt 1
          charcnt  1
    ) ;_ end of setq
  ) ;_ end of while
  (SETQ abbr_lst (ACAD_STRLSORT abbr_lst))
  (SETQ abbr_out (OPEN (STRCAT (GETVAR "dwgprefix")
                               (IF (EQ earall "Create")
                                 (SUBSTR (GETVAR "dwgname") 1 (- (STRLEN (GETVAR "dwgname")) 4))
                                 ""
                               ) ;_ end of IF
                               "allword.txt"
                       ) ;_ end of STRCAT
                       "w"
                 ) ;_ end of OPEN
  ) ;_ end of SETQ
  (FOREACH n abbr_lst (PRINC (STRCAT n "\n") abbr_out))
  (CLOSE abbr_out)
) ;_ end of defun
(DEFUN C:ABBRFILES (/ str_found srch_list)
  (SETQ abbrfile_list (DOS_DIR (STRCAT (GETVAR "DWGPREFIX") "*ALLWORD.TXT")))
  (SETQ a_list_file (OPEN (STRCAT (GETVAR "DWGPREFIX") "A-LIST.TXT") "r"))
  (IF (AND abbrfile_list a_list_file)
    (PROGN (WHILE (SETQ srch_word (READ-LINE a_list_file))
             (SETQ srch_list (APPEND srch_list (LIST srch_word)))
           ) ;_ end of WHILE
           (CLOSE a_list_file)
           (SETQ abbr_shtlst (OPEN (STRCAT (GETVAR "DWGPREFIX") "abbr_shts.txt") "w"))
           (FOREACH srch_str srch_list
             (PRINC (STRCAT "\n" srch_str))
             (WRITE-LINE srch_str abbr_shtlst)
             (snglabbrsrch srch_str)
           ) ;_ end of FOREACH
           (CLOSE abbr_shtlst)
    ) ;_ end of PROGN
    (COND
      (a_list_file
       (PRINC
         (strcat
           "\nRun the ABBRLST command or (abbrlst) function with the \"Create\" option on the sheets you want to check in "
           (getvar "dwgprefix")
           " "
         ) ;_ end of strcat
       ) ;_ end of PRINC
      )
      (abbrfile_list
       (PRINC (strcat "\nCreate a file named \"A-LIST.TXT\" in "
                      (getvar "dwgprefix")
                      " containing your abbreviations, one abbreviation per line. "
              ) ;_ end of strcat
       ) ;_ end of PRINC
      )
      (T
       (PRINC
         "\nCreate a file named \"A-LIST.TXT\" containing your abbreviations, one abbreviation per line. "
       ) ;_ end of PRINC
       (PRINC
         "\nRun the ABBRLST command or (abbrlst) function with the \"Add\" option on the sheets you want to check and then edit \"ALLWORD.TXT\".  Save it as \"A-LIST.TXT\" "
       ) ;_ end of PRINC
       (PRINC
         "\nRun the ABBRLST command or (abbrlst) function with the \"Create\" option on the sheets you want to check "
       ) ;_ end of PRINC
      )
    ) ;_ end of COND
  ) ;_ end of IF
  (PRINC)
) ;_ end of DEFUN
(DEFUN C:ABBRSRCH (/ cl_srch)
  (SETQ srch_str (ustr 1 "\nEnter case sensitive abbreviation to search for. " srch_str T))
  (SETQ cl_srch T)
  (snglabbrsrch srch_str)
) ;_ end of DEFUN
(DEFUN snglabbrsrch (str /)
  (FOREACH n abbrfile_list
    (SETQ openabbr (OPEN (STRCAT (GETVAR "dwgprefix") n) "r"))
    (WHILE (SETQ abbr_rdln (READ-LINE openabbr))
      (IF (WCMATCH abbr_rdln str)
        (SETQ str_found T)
      ) ;_ end of if
    ) ;_ end of while
    (CLOSE openabbr)
    (IF (AND str_found (NOT (WCMATCH (STRCASE n) "ALLWORD.TXT")))
      (PROGN (PRINC "\n\t\t")
             (PRINC (SUBSTR n 1 (- (STRLEN n) 11)))
             (PRINC)
             (IF cl_srch
               NIL
               (WRITE-LINE (STRCAT "\t\t" (SUBSTR n 1 (- (STRLEN n) 11))) abbr_shtlst)
             ) ;_ end of IF
      ) ;_ end of PROGN
    ) ;_ end of if
    (SETQ str_found nil)
  ) ;_ end of foreach
) ;_ end of DEFUN
;|«Visual LISP© Format Options»
(120 2 15 2 T "end of " 100 9 2 0 nil nil nil T T)
;*** DO NOT add text below the comment! ***|;