Jump to content

Exporting Text

CADTutor

By CADTutor
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

CADTutor Veteran

CADTutor

Posted
Posted (edited)

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.

 

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

 

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

Edited by SLW210
Code Tags added.
Link to comment
Share on other sites
  • 1 month later...
fuccaro Veteran

fuccaro

Posted
Posted (edited)

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))

Edited by SLW210
Add Code Tags
Link to comment
Share on other sites
  • 2 years later...
msstrang Newbie

msstrang

Posted
Posted (edited) 

(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?

Edited by SLW210
Add Code Tags
Link to comment
Share on other sites
  • 1 year later...
mikeadams Newbie

mikeadams

Posted
Posted (edited)
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.

 

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

 

 

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?

Edited by SLW210
Add Code Tags.
Link to comment
Share on other sites
pefi Enthusiast

pefi

Posted
Posted

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

Link to comment
Share on other sites
kpblc Enthusiast

kpblc

Posted
Posted

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

Link to comment
Share on other sites
CAB Proficient

CAB

Posted
Posted

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" . )
       )
     )
      (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 ))

            ;; 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
;;;======================================================================

Link to comment
Share on other sites
  • 3 years later...
Marc5 Collaborator

Marc5

Posted
Posted

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

 

Thanks again,

Marc5

Link to comment
Share on other sites
  • 1 year later...
kam1967 Contributor

kam1967

Posted
Posted

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" . )
)
)
(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 ))

;; 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
;;;======================================================================

Link to comment
Share on other sites
Marc5 Collaborator

Marc5

Posted
Posted

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

Link to comment
Share on other sites
  • 4 weeks later...
BLWNHR Rookie

BLWNHR

Posted
Posted

Hi guys, I've been using this script for a while now, but it has stopped working and I cannot work out why. Same version of AutoCAD (2011), just a new installation. I just get the following:

 

Command: _appload txtex.lsp successfully loaded.


Command:
Command:
Command: TXTEX
nil

Command:

 

And no txt file. Does anyone have any idea on what's happening? I've tried this code and this code and neither work.

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted

Try this from my library:

[color=GREEN];; Text 2 CSV  -  Lee Mac[/color]
[color=GREEN];; Writes all Text, MText & Attribute content from all layouts and within[/color]
[color=GREEN];; all blocks and nested blocks to a selected CSV file.[/color]

([color=BLUE]defun[/color] c:txt2csv ( [color=BLUE]/[/color] data file )
   ([color=BLUE]cond[/color]
       (   ([color=BLUE]not[/color]
               ([color=BLUE]progn[/color]
                   ([color=BLUE]vlax-for[/color] block ([color=BLUE]vla-get-blocks[/color] ([color=BLUE]vla-get-activedocument[/color] ([color=BLUE]vlax-get-acad-object[/color])))
                       ([color=BLUE]if[/color] ([color=BLUE]eq[/color] [color=BLUE]:vlax-false[/color] ([color=BLUE]vla-get-isxref[/color] block))
                           ([color=BLUE]vlax-for[/color] obj block
                               ([color=BLUE]cond[/color]
                                   (   ([color=BLUE]wcmatch[/color] ([color=BLUE]vla-get-objectname[/color] obj) [color=MAROON]"AcDb*Text"[/color])
                                       ([color=BLUE]setq[/color] data ([color=BLUE]cons[/color] ([color=BLUE]vla-get-textstring[/color] obj) data))
                                   )
                                   (   ([color=BLUE]and[/color]
                                           ([color=BLUE]eq[/color] [color=MAROON]"AcDbBlockReference"[/color] ([color=BLUE]vla-get-objectname[/color] obj))
                                           ([color=BLUE]eq[/color] [color=BLUE]:vlax-true[/color] ([color=BLUE]vla-get-hasattributes[/color] obj))
                                       )
                                       ([color=BLUE]foreach[/color] att ([color=BLUE]vlax-invoke[/color] obj 'getattributes)
                                           ([color=BLUE]setq[/color] data ([color=BLUE]cons[/color] ([color=BLUE]vla-get-textstring[/color] att) data))
                                       )
                                   )
                               )
                           )
                       )
                   )
                   data
               )
           )
           ([color=BLUE]princ[/color] [color=MAROON]"\nNo Text, MText or Attributes found."[/color])
       )
       (   ([color=BLUE]not[/color] ([color=BLUE]setq[/color] file ([color=BLUE]getfiled[/color] [color=MAROON]"Create CSV file"[/color] [color=MAROON]""[/color] [color=MAROON]"csv"[/color] 1)))
           ([color=BLUE]princ[/color] [color=MAROON]"\n*Cancel*"[/color])
       )
       (   ([color=BLUE]setq[/color] file ([color=BLUE]open[/color] file [color=MAROON]"w"[/color]))
           ([color=BLUE]foreach[/color] x data ([color=BLUE]write-line[/color] x file))
           ([color=BLUE]setq[/color] file ([color=BLUE]close[/color] file))
           ([color=BLUE]princ[/color] ([color=BLUE]strcat[/color] [color=MAROON]"\n"[/color] ([color=BLUE]itoa[/color] ([color=BLUE]length[/color] data)) [color=MAROON]" strings written to file."[/color]))
       )
       (   ([color=BLUE]princ[/color] [color=MAROON]"\nUnable to open CSV file for writing."[/color]))
   )
   ([color=BLUE]princ[/color])
)
([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])

Link to comment
Share on other sites
BLWNHR Rookie

BLWNHR

Posted
Posted

Thanks Lee Mac. I figured out what had happened. Those other scripts were working, but for some reason AutoCAD was not putting the file in the same directory as the drawing, I found it during a search of my storage drive. I worked out that if I open a new instance of AutoCAD, then open the drawing, it will output the file into the DWG file directory.

 

I am using this to export valve and pipe tag numbers from a drawing so we can compare it with an older listing. All these tags are on one layer (P-LABL) so I just isolate this layer and run TXTEX and it only exports the current layer. I see yours exports all the text from the drawing. I appreciate you posting this and I will file it away for when I need this functionality. Thanks for taking the time to post for me.

Link to comment
Share on other sites
  • 1 month later...
  • 4 weeks later...
  • 1 year later...
minhphuong_humg Enthusiast

minhphuong_humg

Posted
Posted
Try this from my library:

[color=GREEN];; Text 2 CSV  -  Lee Mac[/color]
[color=GREEN];; Writes all Text, MText & Attribute content from all layouts and within[/color]
[color=GREEN];; all blocks and nested blocks to a selected CSV file.[/color]

([color=BLUE]defun[/color] c:txt2csv ( [color=BLUE]/[/color] data file )
   ([color=BLUE]cond[/color]
       (   ([color=BLUE]not[/color]
               ([color=BLUE]progn[/color]
                   ([color=BLUE]vlax-for[/color] block ([color=BLUE]vla-get-blocks[/color] ([color=BLUE]vla-get-activedocument[/color] ([color=BLUE]vlax-get-acad-object[/color])))
                       ([color=BLUE]if[/color] ([color=BLUE]eq[/color] [color=BLUE]:vlax-false[/color] ([color=BLUE]vla-get-isxref[/color] block))
                           ([color=BLUE]vlax-for[/color] obj block
                               ([color=BLUE]cond[/color]
                                   (   ([color=BLUE]wcmatch[/color] ([color=BLUE]vla-get-objectname[/color] obj) [color=MAROON]"AcDb*Text"[/color])
                                       ([color=BLUE]setq[/color] data ([color=BLUE]cons[/color] ([color=BLUE]vla-get-textstring[/color] obj) data))
                                   )
                                   (   ([color=BLUE]and[/color]
                                           ([color=BLUE]eq[/color] [color=MAROON]"AcDbBlockReference"[/color] ([color=BLUE]vla-get-objectname[/color] obj))
                                           ([color=BLUE]eq[/color] [color=BLUE]:vlax-true[/color] ([color=BLUE]vla-get-hasattributes[/color] obj))
                                       )
                                       ([color=BLUE]foreach[/color] att ([color=BLUE]vlax-invoke[/color] obj 'getattributes)
                                           ([color=BLUE]setq[/color] data ([color=BLUE]cons[/color] ([color=BLUE]vla-get-textstring[/color] att) data))
                                       )
                                   )
                               )
                           )
                       )
                   )
                   data
               )
           )
           ([color=BLUE]princ[/color] [color=MAROON]"\nNo Text, MText or Attributes found."[/color])
       )
       (   ([color=BLUE]not[/color] ([color=BLUE]setq[/color] file ([color=BLUE]getfiled[/color] [color=MAROON]"Create CSV file"[/color] [color=MAROON]""[/color] [color=MAROON]"csv"[/color] 1)))
           ([color=BLUE]princ[/color] [color=MAROON]"\n*Cancel*"[/color])
       )
       (   ([color=BLUE]setq[/color] file ([color=BLUE]open[/color] file [color=MAROON]"w"[/color]))
           ([color=BLUE]foreach[/color] x data ([color=BLUE]write-line[/color] x file))
           ([color=BLUE]setq[/color] file ([color=BLUE]close[/color] file))
           ([color=BLUE]princ[/color] ([color=BLUE]strcat[/color] [color=MAROON]"\n"[/color] ([color=BLUE]itoa[/color] ([color=BLUE]length[/color] data)) [color=MAROON]" strings written to file."[/color]))
       )
       (   ([color=BLUE]princ[/color] [color=MAROON]"\nUnable to open CSV file for writing."[/color]))
   )
   ([color=BLUE]princ[/color])
)
([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])

Please edit your lisp help me.

Your lisp do very good. However, it don't sort. I want sort as file attach. Please, thanks.

want.PNG

Result your lisp.csv

Help.dwg

Link to comment
Share on other sites
wkplan Enthusiast

wkplan

Posted
Posted

minhphuong_humg,

 

your sample drawing contains only text-elements and dimensions.

There is no way to do any kind of sorting, because each element is isolated to it self.

How should a lisp decide which text is related to another text or dimension?

 

Think about using blocks with attributes inside, than using the built-in data-extraction function.

 

regards

Wolfgang

Link to comment
Share on other sites
  • 2 years later...
at22134 Newbie

at22134

Posted
Posted
Try this from my library:

[color=GREEN];; Text 2 CSV  -  Lee Mac[/color]
[color=GREEN];; Writes all Text, MText & Attribute content from all layouts and within[/color]
[color=GREEN];; all blocks and nested blocks to a selected CSV file.[/color]

([color=BLUE]defun[/color] c:txt2csv ( [color=BLUE]/[/color] data file )
   ([color=BLUE]cond[/color]
       (   ([color=BLUE]not[/color]
               ([color=BLUE]progn[/color]
                   ([color=BLUE]vlax-for[/color] block ([color=BLUE]vla-get-blocks[/color] ([color=BLUE]vla-get-activedocument[/color] ([color=BLUE]vlax-get-acad-object[/color])))
                       ([color=BLUE]if[/color] ([color=BLUE]eq[/color] [color=BLUE]:vlax-false[/color] ([color=BLUE]vla-get-isxref[/color] block))
                           ([color=BLUE]vlax-for[/color] obj block
                               ([color=BLUE]cond[/color]
                                   (   ([color=BLUE]wcmatch[/color] ([color=BLUE]vla-get-objectname[/color] obj) [color=MAROON]"AcDb*Text"[/color])
                                       ([color=BLUE]setq[/color] data ([color=BLUE]cons[/color] ([color=BLUE]vla-get-textstring[/color] obj) data))
                                   )
                                   (   ([color=BLUE]and[/color]
                                           ([color=BLUE]eq[/color] [color=MAROON]"AcDbBlockReference"[/color] ([color=BLUE]vla-get-objectname[/color] obj))
                                           ([color=BLUE]eq[/color] [color=BLUE]:vlax-true[/color] ([color=BLUE]vla-get-hasattributes[/color] obj))
                                       )
                                       ([color=BLUE]foreach[/color] att ([color=BLUE]vlax-invoke[/color] obj 'getattributes)
                                           ([color=BLUE]setq[/color] data ([color=BLUE]cons[/color] ([color=BLUE]vla-get-textstring[/color] att) data))
                                       )
                                   )
                               )
                           )
                       )
                   )
                   data
               )
           )
           ([color=BLUE]princ[/color] [color=MAROON]"\nNo Text, MText or Attributes found."[/color])
       )
       (   ([color=BLUE]not[/color] ([color=BLUE]setq[/color] file ([color=BLUE]getfiled[/color] [color=MAROON]"Create CSV file"[/color] [color=MAROON]""[/color] [color=MAROON]"csv"[/color] 1)))
           ([color=BLUE]princ[/color] [color=MAROON]"\n*Cancel*"[/color])
       )
       (   ([color=BLUE]setq[/color] file ([color=BLUE]open[/color] file [color=MAROON]"w"[/color]))
           ([color=BLUE]foreach[/color] x data ([color=BLUE]write-line[/color] x file))
           ([color=BLUE]setq[/color] file ([color=BLUE]close[/color] file))
           ([color=BLUE]princ[/color] ([color=BLUE]strcat[/color] [color=MAROON]"\n"[/color] ([color=BLUE]itoa[/color] ([color=BLUE]length[/color] data)) [color=MAROON]" strings written to file."[/color]))
       )
       (   ([color=BLUE]princ[/color] [color=MAROON]"\nUnable to open CSV file for writing."[/color]))
   )
   ([color=BLUE]princ[/color])
)
([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])

 

Sorry for reviving such an old topic. Just want to say that this code by lee mac is great! However, are there any ways to modify it so that it lists the texts/mtxt/attr in an order from left to right as it appears in the drawing (also adding an x,y coordinate next to each text)? Also, are there ways to add a condition to only list texts/mtxt/attr that has 3 decimal places?

 

Thank you for reading!

Link to comment
Share on other sites
  • 1 year later...
bijith Newbie

bijith

Posted
Posted
Hi guys, I've been using this script for a while now, but it has stopped working and I cannot work out why. Same version of AutoCAD (2011), just a new installation. I just get the following:

 

Command: _appload txtex.lsp successfully loaded.


Command:
Command:
Command: TXTEX
nil

Command:

 

And no txt file. Does anyone have any idea on what's happening? I've tried this code and this code and neither work.

 

same issue... "nil"

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...