导出文本

CADTutor · 发表于 2022-7-5 15:49:56

这里是另一个从旧论坛上弹出的晦涩中拯救出来的宝石。

您希望从图形中输出文本。用这一点
AutoLISP应用程序。该应用程序将帮助您
达到理想的结果


[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]

将程序复制到记事本中打开的文件中。然后
将其保存为TXTEX。LSP。下一次加载
AutoCAD并运行它。

要运行程序，请在命令处键入TXTEX
促使这就是全部。创建的文本文件包含
在图纸中找到的所有文本。

您可以将文本文件插入Microsoft Excel或
Microsoft Word。我相信你知道怎么做。
否则请回到我身边。

等一下。你说的是100幅画
文本你想一次完成吗？如果是这样，我们必须
对程序进行一些修改。

您还需要一个脚本文件。脚本文件运行并
启动程序。每次创建文本文件时。
让我知道你想要什么。

Jos van Doorn。AutoCAD专家和AutoLISP
程序员同时出版ACAD时事通讯。免费。到
订阅发送空白电子邮件至：
acadnewsletter公司-subscribe@topica.com

fuccaro · 发表于 2022-7-5 15:55:51

不错的节目。文本按创建顺序放置在文本文件中，忽略屏幕位置。如果您希望控制订单，或者当您不�如果不需要从DWG中导出所有文本，可以尝试以下程序。您可能需要使用其他应用程序编辑文本文件。
重要提示：您选择的（M）文本将被删除，因此请操作DWG文件的副本！

copy


(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 · 发表于 2022-7-5 15:56:53

copy


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

我用这个lisp，它过去很管用。
但现在，当我运行它时，当我打开dtext时。txt文件它是空的。
什么会导致这种情况发生？

mikeadams · 发表于 2022-7-5 16:00:48

可爱的小节目，干杯！
有没有办法指定程序将在其上操作的层或使其仅在当前层上操作？

pefi · 发表于 2022-7-5 16:05:09

试试这个：

copy

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

应适用于当前层
普尔泽莫

kpblc · 发表于 2022-7-5 16:07:30

如果您使用的是Autocad 2002及更高版本，并且希望获得完整的多行文字字符串（不带格式），则可以尝试使用以下内容：
代码擦除'cos包含一些错误（thnx到ASMI）此代码工作正常（我希望）：

copy

(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 · 发表于 2022-7-5 16:11:29

这是一个有一些选项的快捷方式。

copy

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