Exporting Text

[CADTutor]

Here's another gem rescued from pop-up obscurity on the old forum.

You want to export text from a drawing. Use this little
AutoLISP application. The application will help you to
do the trick.

(defun c:txtex (/ et)
(setq fl (open "dtext.txt" "w")
et (entnext)
)
(while et
(setq el (entget et)
tp (cdr (assoc 0 el))
)
(if (or (= tp "TEXT") (= tp "MTEXT"))
(write-line (cdr (assoc 1 el)) fl)
)
(setq et (entnext et))
)
(close fl)
)

Copy the program to a file opened in Notepad. And then
save it under the name TXTEX.LSP. Next load it in
AutoCAD and run it.

To run the program you type TXTEX at the command
prompt. That's all. A text file is created containing
all the text found in the drawing.

You can insert the text file in Microsoft Excel or
Microsoft Word. I trust you know how to do it.
Otherwise come back to me.

Wait a minute. You were talking about 100 drawings with
text. Do you want to do it in one run? If so we must
make some chnages to the program.

You also need a script file. The script file runs and
starts the program. Each time a text file is created.
Let me know what you want.

Jos van Doorn. AutoCAD specialist and AutoLISP
programmer. Also publisher ACAD Newsletter. FREE. To
subscribe send a blank e-mail to:
acadnewsletter-subscribe@topica.com

[fuccaro]

Nice program. The text is placed in the text file in the order it was created, screen-position is ignored. If you wish to control the order, or when you don�t need to export all text from the DWG, you may try the following program. Probably you will need to edit the text file with other applications.
IMPORTANT: THE (M)TEXT YOU SELECT WILL BE DELETED, SO OPERATE ON A COPY OF YOUR DWG FILE!

(defun C:TEX()
  ;move selected text to file
  (alert "I hope you have a copy of your DWG!")
  (setq userfile (open "test13.txt" "w"));You
              ;may change the name of the text file
  (setq txt (entsel "select (m)text"))
  (while txt
    (setq e (entget (car txt)))
    (setq x nil line "")
    (setq x (member (assoc 3 e) e))
    (while x
      (setq line (cdr (assoc 3 x)))
      (write-line line userfile)
      (setq x (cdr x))
      (setq x (member (assoc 3 x) x)))
    (setq line (cdr (assoc 1 e)))
    (write-line line userfile)
    (command "erase" txt "")
    (setq txt(entsel "\nnext (m)text (Enter for terminate)")))
  (close userfile))

[msstrang]

(defun c:txtex (/ et)
(setq fl (open "dtext.txt" "w")
et (entnext)
)
(while et
(setq el (entget et)
tp (cdr (assoc 0 el))
)
(if (or (= tp "TEXT") (= tp "MTEXT"))
(write-line (cdr (assoc 1 el)) fl)
)
(setq et (entnext et))
)
(close fl)
)

i use this lisp, and it used to work.
but now when i run it, when i open the dtext.txt file it is empty.
what could cause this to happen?

[mikeadams]

Here's another gem rescued from pop-up obscurity on the old forum.

You want to export text from a drawing. Use this little
AutoLISP application. The application will help you to
do the trick.

(defun c:txtex (/ et)
(setq fl (open "dtext.txt" "w")
et (entnext)
)
(while et
(setq el (entget et)
tp (cdr (assoc 0 el))
)
(if (or (= tp "TEXT") (= tp "MTEXT"))
(write-line (cdr (assoc 1 el)) fl)
)
(setq et (entnext et))
)
(close fl)
)

Lovely little program, cheers!
Is there a way to specify the layer(s) the program will operate on or make it only operate on the current layer?

[pefi]

Try this:

(defun c:txtex (/ file,en,entity,current_layer,entity_layer)
  (setq    file (open "dtext.txt" "w")
    en   (entnext)
  )
  (setq current_layer (getvar 'clayer))
  (while en
    (setq entity       (entget en)
      text           (cdr (assoc 0 entity))
      entity_layer (cdr (assoc 8 entity))
    )
    (if    (and (or (= text "TEXT")
         (= text "MTEXT")
         )
         (= entity_layer current_layer)
    )
      (write-line (cdr (assoc 1 entity)) file)
    )
    (setq en (entnext en))
  )
  (close file)
)

Should work on current layer
Przemo

[kpblc]

If you're using Autocad 2002 and later and if you want to get full mtext strings (w/o formatting) you can try to use something like this:
<...> code erased 'cos contains some errors (thnx to ASMI) This code works correctly (i hope):

(defun c:text-exp (/                      *error*
                   file                   selset
                   file_handle            kpblc-string-mtext-unformat
                   _kpblc-string-replace  _kpblc-string-cut-between
                   bylayer
                   )

  (defun _kpblc-string-cut-between (str s1 s2 reg / tmp substring)
    (setq tmp       (if s1
                      (kpblc-string-find-substr-pass str s1 reg 0)
                      1
                      ) ;_ end of if
          substring (kpblc-string-find-substr-pass str s2 reg tmp)
          ) ;_ end of setq
    (if (and (or s1 s2) tmp substring)
      (substr
        str
        tmp
        (if (and s2 tmp)
          (1+ (- (kpblc-string-find-substr-pass str s2 reg tmp)
                 tmp
                 ) ;_ end of -
              ) ;_ end of 1+
          ) ;_ end of if
        ) ;_ end of substr
      ""
      ) ;_ end of if
    ) ;_ end of defun

  (defun *error* (msg)
    (vl-catch-all-apply '(lambda () (close file_handle)))
    (princ msg)
    (princ)
    ) ;_ end of defun

  (defun _kpblc-string-replace (string old_substr new_substr / pos)
    (while (setq pos (vl-string-search old_substr string))
      (setq string
             (strcat
               (substr string 1 pos)
               new_substr
               (_kpblc-string-replace
                 (substr string (+ (strlen old_substr) pos 1))
                 old_substr
                 new_substr
                 ) ;_ end of _kpblc-string-replace
               ) ;_ end of strcat
            ) ;_ end of setq
      ) ;_ end of while
    string
    ) ;_ end of defun

  (defun kpblc-string-mtext-unformat (ent
                                      /
                                      _tmp
                                      _substr
                                      _mtext-str-extractor-clr
                                      _mtext-str-extractor-srch
                                      )
    (defun _mtext-str-extractor-clr (str / _pos)
      (if (setq _pos (_mtext-str-extractor-srch
                       str
                       '("{\\" "\\f" "\\F")
                       ) ;_ end of _mtext-str-extractor-srch
                ) ;_ end of setq
        (strcat
          (if (> _pos 0)
            (substr str 1 _pos)
            ""
            ) ;_ end of if
          (_mtext-str-extractor-clr
            (substr
              str
              (+ 2 (vl-string-search ";" str (1+ _pos)))
              ) ;_ end of substr
            ) ;_ end of _mtext-str-extractor-clr
          ) ;_ end of strcat
        str
        ) ;_ end of if
      ) ;_ end of defun
    (defun _mtext-str-extractor-srch (str lst / _tmp)
      (car (vl-sort
             (vl-remove-if
               'not
               (mapcar (function (lambda (_x _y)
                                   (vl-string-search _y _x)
                                   ) ;_ end of lambda
                                 ) ;_ end of function
                       (repeat (length lst)
                         (setq _tmp (cons str _tmp))
                         ) ;_ end of repeat
                       lst
                       ) ;_ end of mapcar
               ) ;_ end of vl-remove-if
             '<
             ) ;_ end of vl-sort
           ) ;_ end of car
      ) ;_ end of defun
    (setq
      _tmp (vl-string-subst
             ""
             "}"
             (_mtext-str-extractor-clr
               (_kpblc-string-replace
                 (_kpblc-string-replace
                   (_kpblc-string-replace
                     (_kpblc-string-replace
                       (_kpblc-string-replace
                         (_kpblc-string-replace
                           ent
                           "\\\\"
                           ""
                           ) ;_ end of _kpblc-string-replace
                         "\\{"
                         (chr 1)
                         ) ;_ end of _kpblc-string-replace
                       "\\}"
                       (chr 2)
                       ) ;_ end of _kpblc-string-replace
                     "\\P"
                     "\n"
                     ) ;_ end of _kpblc-string-replace
                   "\\L"
                   ""
                   ) ;_ end of _kpblc-string-replace
                 "\\l"
                 ""
                 ) ;_ end of _kpblc-string-replace
               ) ;_ end of _mtext-str-extractor-clr
             ) ;_ end of vl-string-subst
      ) ;_ end of setq
    (while
      (and (setq _substr (_kpblc-string-cut-between _tmp "\\" ";" nil))
           (/= _substr "")
           ) ;_ end of and
       (setq _tmp (vl-string-subst "" _substr _tmp))
       ) ;_ end of while
    (vl-string-subst "}" (chr 2) (vl-string-subst "{" (chr 1) _tmp))
    _tmp
    ) ;_ end of defun

  (vl-load-com)
  (if (and (setq file (getfiled "Enter a new export file name" "" "txt" 1))
           (setq selset (ssget
                          (if (= (setq bylayer
                                        ((lambda ()
                                           (initget "Yes No _ Y N")
                                           (getkword
                                             "\nSelect by current layer [Yes/No] <No> : "
                                             ) ;_ end of getkword
                                           ) ;_ end of lambda
                                         )
                                       ) ;_ end of setq
                                 "Y"
                                 ) ;_ end of =
                            (list (cons 0 "*TEXT") (cons 8 (getvar "clayer")))
                            (list (cons 0 "*TEXT"))
                            ) ;_ end of if
                          ) ;_ end of ssget
                 ) ;_ end of setq
           ) ;_ end of and
    (progn
      (setq file_handle (open file "w"))
      (foreach item
               (mapcar 'vlax-ename->vla-object
                       (vl-remove-if 'listp (mapcar 'cadr (ssnamex selset)))
                       ) ;_ end of mapcar
        (write-line
          (vl-string-translate
            "\n"
            " "
            (vl-string-translate "\\P" " " (vla-get-textstring item))
            ) ;_ end of VL-STRING-TRANSLATE
          file_handle
          ) ;_ end of write-line
        ) ;_ end of foreach
      (close file_handle)
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of defun

[CAB]

Here is a quickie with some options.

;;  TextOut.lsp by CAB
;;  Version 1  01/26/07
(defun c:TextOut()
  (TextOutSub (+ 1 2 16) nil) ; get text & mText & Strip
  (princ)
)

;;  Dump text strings in drawing to a text file
;;  Output File name -> <DWG filename> + "-OUT.TXT"
;;  Flags to filter object Type
;;  Layer Name   nil = any layer
(defun TextOutSub(flag lname / fl ent)
  (vl-load-com)
  ;;  Flags
  ;;  1  Text
  ;;  2  MText
  ;;  4  Attributes
  ;;  8  Attribute Definition
  ;;  16 Strip Text Format characters
  ;;  32 

  ;;  lname   if nil use any layer
  
  ;;++++++++++++++++++++++++++++++++++++++++++++++++++++++ 
  ;;  test ename, return objtype if correct type else nil 
  ;;++++++++++++++++++++++++++++++++++++++++++++++++++++++
  (defun is_text (ename / obj typ)
    (if
      (setq typ
        (assoc
          (vla-get-objectname (setq obj (vlax-ename->vla-object ename)))
          '(("AcDbText" . 1) ("AcDbMText" . 2) ("AcDbAttribute" . 4) ("AcDbAttributeDefinition" . 8))
        )
      )
       (cons obj (cdr typ))
    )
  )

  (setq fname (strcat (getvar "dwgprefix")
                      (vl-filename-base (getvar "dwgname"))
                      "-OUT.TXT"
       ))
  (setq fl (open fname "w"))
  (if lname
    (progn
      (write-line (strcat "***  Filtered by Layer " lname " ***") fl)
      (setq lname (strcase lname))
    )
  )
  (while (setq ent (if ent (entnext ent)(entnext)))
    (if (and (setq source (is_text ent))
             (> (logand (cdr source) flag) 0)
             (or (null lname)
                 (= (strcase (vla-get-layer (car source))) lname)
             ))
      (progn
        (setq TextSource (vla-get-textstring (car source)))
        (and (> (logand 16 flag) 0) (setq TextSource (strip_text TextSource)))
        (write-line (strcat "\n<---->  " (substr (vla-get-objectname (car source)) 5)
                            "\n" TextSource) fl)
      )
    )
  )
  (close fl)
  (princ)
  )





;;;=======================[ Strip_Text.lsp ]=============================
;;; Author:  Charles Alan Butler Copyright© 2005 
;;; Version: 2.2  Oct. 19, 2005
;;; Purpose: Strip format characters from text or mtext
;;; Returns: A string  
;;; Sub_Routines: -None
;;; Arguments: A string variable
;;;======================================================================

(defun strip_text (str / skipcnt ndx newlst char fmtcode lst_len
                   IS_MTEXT LST  NEXTCHR PT TMP)

  (setq ndx 0
        ;; "fmtcode" is a list of code flags that will end with ; 
        fmtcode
         (vl-string->list "CcFfHhTtQqWwAa") ;("\C" "\F" "\H" "\T" "\Q" "\W" "\A")
  )
  (if (/= str "") ; skip if empty text ""
    (progn
      (setq lst      (vl-string->list str)
            lst_len  (length lst)
            newlst   '()
            is_mtext nil ; true if mtext
      )
      (while (< ndx lst_len)
        ;; step through text and find FORMAT CHARACTERS
        (setq char    (nth ndx lst) ; Get next character
              nextchr (nth (1+ ndx) lst)
              skipcnt 0
        )

        (cond
          ((and (= char 123) (= nextchr 92)) ; "{\" mtext code
           (setq is_mtext t
                 skipcnt 1
           )
          )

          ((and (= char 125) is_mtext) ; "}"
           (setq skipcnt 1)
          )


          ((= char 37) ; code start with "%"
           (if (null nextchr) ; true if % is last char in text
             (setq skipcnt 1)
             ;;  Dtext codes
             (if (= nextchr 37) ; %% code found 
               (if (< 47 (nth (+ ndx 2) lst) 58) ; is a number
                 ;;number found so fmtcode %%nnn
                 (setq skipcnt 5)
                 ;; else letter code, so fmtcode %%p, %%d, %%c
                 ;;  CAB note - this code does not always exist in the string
                 ;;  it is used to create the character but the actual ascii code
                 ;;  is used in the string, not the case for %%c
                 (setq skipcnt 3)
               ) ; endif
             ) ; endif
           ) ; endif
          ) ; end cond (= char "%"))


          ((= char 92) ; code start with "\" 
           ;;  This section processes mtext codes

           (cond
             ;; Process Coded information
             ((null nextchr) ; true if \ is last char in text
              (setq skipcnt 1)
             ) ; end cond 1

             ((member nextchr fmtcode) ; this code will end with ";"
              ;; fmtcode -> ("\C" "\F" "\H" "\T" "\Q" "\W" "\A"))
              (while (/= (setq char (nth (+ skipcnt ndx) lst)) 59)
                (setq skipcnt (1+ skipcnt))
              )
              (setq skipcnt (1+ skipcnt))
             ) ; end cond 


             ;; found \U then get 7 character group
             ((= nextchr 85) (setq skipcnt (+ skipcnt 7)))

             ;; found \M then get 8 character group
             ((= nextchr 77) (setq skipcnt (+ skipcnt 8)))

             ;; found \P then replace with CR LF 13 10
             ;;  debug do not add CR LF, just remobe \P
             ((= nextchr 80) ; "\P"
              (setq newlst  (append newlst '(32))
                    ;ndx     (+ ndx 1)
                    skipcnt 2
              )
             ) ; end cond 


             ((= nextchr 123) ; "\{" normal brace
              (setq ndx (+ ndx 1))
             ) ; end cond 

             ((= nextchr 125) ; "\}" normal brace
              (setq ndx (+ ndx 1))
             ) ; end cond 

             ((= nextchr 126) ; "\~" non breaking space
              (setq newlst (append newlst '(32))) ; " "
              (setq skipcnt 2) ; end cond 9
             )

             ;; 2 character group \L \l \O \o
            ((member nextchr '(76 108 79 111)) 
              (setq skipcnt 2)
             ) ; end cond 

             ;;  Stacked text format as "[ top_txt / bot_txt ]"
             ((= nextchr 83) ; "\S"
              (setq pt  (1+ ndx)
                    tmp '()
              )
              (while
                (not
                  (member
                    (setq tmp (nth (setq pt (1+ pt)) lst))
                    '(94 47 35) ; "^" "/" "#" seperator
                  )
                )
                 (setq newlst (append newlst (list tmp)))
              )
              (setq newlst (append newlst '(47))) ; "/"
              (while (/= (setq tmp (nth (setq pt (1+ pt)) lst)) 59) ; ";"
                (setq newlst (append newlst (list tmp)))
              )
              (setq ndx     pt
                    skipcnt (1+ skipcnt)
              )
             ) ; end cond 


           ) ; end cond stmt  Process Coded information
          ) ; end cond  (or (= char "\\")

        ) ; end cond stmt
        ;;  Skip format code characters
        (if (zerop skipcnt) ; add char to string
          (setq newlst (append newlst (list char))
                ndx    (+ ndx 1)
          )
          ;;  else skip some charactersPLOTTABS

          (setq ndx (+ ndx skipcnt))
        )

      ) ; end while Loop
    ) ; end progn
  ) ; endif
  (vl-list->string newlst) ; return the stripped string
) ; end defun
;;;======================================================================

[Marc5]

WOW......Thanks for all the options / support. Will give it a try and let all know.

Thanks again,
Marc5

[kam1967]

CAB - Does this work with attributes also? I tried it and it does not appear to pick up any attribute from within the drawing. I like what Lee Mac has done with his attribute extract routine. I wonder if there are any routine that incorporates both. That would be very useful. Thanks.

Here is a quickie with some options.

;; TextOut.lsp by CAB
;; Version 1 01/26/07
(defun c:TextOut()
(TextOutSub (+ 1 2 16) nil) ; get text & mText & Strip
(princ)
)

;; Dump text strings in drawing to a text file
;; Output File name -> <DWG filename> + "-OUT.TXT"
;; Flags to filter object Type
;; Layer Name nil = any layer
(defun TextOutSub(flag lname / fl ent)
(vl-load-com)
;; Flags
;; 1 Text
;; 2 MText
;; 4 Attributes
;; 8 Attribute Definition
;; 16 Strip Text Format characters
;; 32 

;; lname if nil use any layer

;;++++++++++++++++++++++++++++++++++++++++++++++++++++++ 
;; test ename, return objtype if correct type else nil 
;;++++++++++++++++++++++++++++++++++++++++++++++++++++++
(defun is_text (ename / obj typ)
(if
(setq typ
(assoc
(vla-get-objectname (setq obj (vlax-ename->vla-object ename)))
'(("AcDbText" . 1) ("AcDbMText" . 2) ("AcDbAttribute" . 4) ("AcDbAttributeDefinition" . 8))
)
)
(cons obj (cdr typ))
)
)

(setq fname (strcat (getvar "dwgprefix")
(vl-filename-base (getvar "dwgname"))
"-OUT.TXT"
))
(setq fl (open fname "w"))
(if lname
(progn
(write-line (strcat "*** Filtered by Layer " lname " ***") fl)
(setq lname (strcase lname))
)
)
(while (setq ent (if ent (entnext ent)(entnext)))
(if (and (setq source (is_text ent))
(> (logand (cdr source) flag) 0)
(or (null lname)
(= (strcase (vla-get-layer (car source))) lname)
))
(progn
(setq TextSource (vla-get-textstring (car source)))
(and (> (logand 16 flag) 0) (setq TextSource (strip_text TextSource)))
(write-line (strcat "\n<----> " (substr (vla-get-objectname (car source)) 5)
"\n" TextSource) fl)
)
)
)
(close fl)
(princ)
)





;;;=======================[ Strip_Text.lsp ]=============================
;;; Author: Charles Alan Butler Copyright© 2005 
;;; Version: 2.2 Oct. 19, 2005
;;; Purpose: Strip format characters from text or mtext
;;; Returns: A string 
;;; Sub_Routines: -None
;;; Arguments: A string variable
;;;======================================================================

(defun strip_text (str / skipcnt ndx newlst char fmtcode lst_len
IS_MTEXT LST NEXTCHR PT TMP)

(setq ndx 0
;; "fmtcode" is a list of code flags that will end with ; 
fmtcode
(vl-string->list "CcFfHhTtQqWwAa") ;("\C" "\F" "\H" "\T" "\Q" "\W" "\A")
)
(if (/= str "") ; skip if empty text ""
(progn
(setq lst (vl-string->list str)
lst_len (length lst)
newlst '()
is_mtext nil ; true if mtext
)
(while (< ndx lst_len)
;; step through text and find FORMAT CHARACTERS
(setq char (nth ndx lst) ; Get next character
nextchr (nth (1+ ndx) lst)
skipcnt 0
)

(cond
((and (= char 123) (= nextchr 92)) ; "{\" mtext code
(setq is_mtext t
skipcnt 1
)
)

((and (= char 125) is_mtext) ; "}"
(setq skipcnt 1)
)


((= char 37) ; code start with "%"
(if (null nextchr) ; true if % is last char in text
(setq skipcnt 1)
;; Dtext codes
(if (= nextchr 37) ; %% code found 
(if (< 47 (nth (+ ndx 2) lst) 58) ; is a number
;;number found so fmtcode %%nnn
(setq skipcnt 5)
;; else letter code, so fmtcode %%p, %%d, %%c
;; CAB note - this code does not always exist in the string
;; it is used to create the character but the actual ascii code
;; is used in the string, not the case for %%c
(setq skipcnt 3)
) ; endif
) ; endif
) ; endif
) ; end cond (= char "%"))


((= char 92) ; code start with "\" 
;; This section processes mtext codes

(cond
;; Process Coded information
((null nextchr) ; true if \ is last char in text
(setq skipcnt 1)
) ; end cond 1

((member nextchr fmtcode) ; this code will end with ";"
;; fmtcode -> ("\C" "\F" "\H" "\T" "\Q" "\W" "\A"))
(while (/= (setq char (nth (+ skipcnt ndx) lst)) 59)
(setq skipcnt (1+ skipcnt))
)
(setq skipcnt (1+ skipcnt))
) ; end cond 


;; found \U then get 7 character group
((= nextchr 85) (setq skipcnt (+ skipcnt 7)))

;; found \M then get 8 character group
((= nextchr 77) (setq skipcnt (+ skipcnt 8)))

;; found \P then replace with CR LF 13 10
;; debug do not add CR LF, just remobe \P
((= nextchr 80) ; "\P"
(setq newlst (append newlst '(32))
;ndx (+ ndx 1)
skipcnt 2
)
) ; end cond 


((= nextchr 123) ; "\{" normal brace
(setq ndx (+ ndx 1))
) ; end cond 

((= nextchr 125) ; "\}" normal brace
(setq ndx (+ ndx 1))
) ; end cond 

((= nextchr 126) ; "\~" non breaking space
(setq newlst (append newlst '(32))) ; " "
(setq skipcnt 2) ; end cond 9
)

;; 2 character group \L \l \O \o
((member nextchr '(76 108 79 111)) 
(setq skipcnt 2)
) ; end cond 

;; Stacked text format as "[ top_txt / bot_txt ]"
((= nextchr 83) ; "\S"
(setq pt (1+ ndx)
tmp '()
)
(while
(not
(member
(setq tmp (nth (setq pt (1+ pt)) lst))
'(94 47 35) ; "^" "/" "#" seperator
)
)
(setq newlst (append newlst (list tmp)))
)
(setq newlst (append newlst '(47))) ; "/"
(while (/= (setq tmp (nth (setq pt (1+ pt)) lst)) 59) ; ";"
(setq newlst (append newlst (list tmp)))
)
(setq ndx pt
skipcnt (1+ skipcnt)
)
) ; end cond 


) ; end cond stmt Process Coded information
) ; end cond (or (= char "\\")

) ; end cond stmt
;; Skip format code characters
(if (zerop skipcnt) ; add char to string
(setq newlst (append newlst (list char))
ndx (+ ndx 1)
)
;; else skip some charactersPLOTTABS

(setq ndx (+ ndx skipcnt))
)

) ; end while Loop
) ; end progn
) ; endif
(vl-list->string newlst) ; return the stripped string
) ; end defun
;;;======================================================================

[Marc5]

It appears there are two different lisps. Is this correct? Also, who is Lee Mac? I looked below and I do not see a Lee Mac. Sorry.

Marc