[编程申请]：我想实现这样一个功能，把dwg中的text输出到一个*.txt文件

zyjcad · 发表于 2002-4-29 01:43:18

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

能把dwg中的text输出到一个*.txt文件吗？
问题的提出：
在平时写施工图设计说明时，我们可能要插入一些已经写好的文字说明图块，然后在acad中调整，大小、字体形式、字距、行距，很费事，特别是大批的文字：），如果能把dwg中的文字用一个程序全输出到*.txt文件中，然后修改，完后在插入dwg文件中，这样比较整齐、好看、省事。
希望大家帮忙解决！

上传一图纸说明，供大家编程测试：）（附赠一字体）

e2002 · 发表于 2002-4-29 02:09:26

这种程序可以说也是多如牛毛了，到cadalog上找找吧...

我提供的那个PowerTools里面也有一个（是别人写的），实现了dwg中的Text和文本文件间的输入输出。

来也匆匆 · 发表于 2002-4-29 11:37:04

收集的lsp

;program 1
(defun c:txttof (/ mma 2pi fn ss name str str1 a p0 x
x0 y y1 h h1 hn w wn n n1 l
lwz lwz1 tfhz
)
(if (and (setq name (getfiled "请输入文本文件的名称:" "" "" 1))
(princ "\n请选取要转换成文本文件的文字 <退出>: ")
(setq ss (ssget '((0 . "TEXT"))))
)
(progn
(sndtin)
(setq mma 1e-3
2pi (+ pi pi)
hn 0
wn 0
n1 0
x0 1e9
)
(transws ss 0)
(while (slb_slb 0)
(setq a (gcolor 50))
(if (or (equal a 0 mma) (equal a 2pi mma))
(progn
(setq p0 (gcolor 10)
str (gcolor 1)
h (gcolor 40)
w (* h (gcolor 41))
n (strlen str)
)
(if (> (ascii str) 160)
(setq tfhz T
n (/ n 2)
)
)
(setq hn (+ hn (* h n))
wn (+ wn (* w n))
n1 (+ n1 n)
x (car p0)
x0 (if (< x x0)
x
x0
)
lwz (cons (list (cadr p0) x str) lwz)
)
)
)
)
(setq h (/ hn n1 2)
w (/ wn
n1
(if tfhz
2
1
)
)
lwz (reverse (apply 'getspt lwz))
fn (open name "w")
)
(while lwz
(setq l (car lwz)
y1 (car l)
lwz (cdr lwz)
lwz1 (list (cdr l))
h1 0
)
(while (and (setq l (car lwz))
(> h
(setq y (car l)
h1 (- y1 y)
)
)
)
(setq lwz (cdr lwz)
lwz1 (cons (cdr l) lwz1)
)
)
(setq h1 (fix (- (/ h1 h 3) 0.5))
lwz1 (apply 'mkpatb lwz1)
str1 ""
n1
0
)
(foreach l lwz1
(setq n (fix (+ 0.5 (/ (- (car l) x0) w)))
str (cadr l)
)
(cond
((> n n1)
(repeat (- n n1)
(setq str1 (strcat str1 " "))
)
)
((< n n1) (setq str1 (substr str1 1 n)))
)
(setq str1 (strcat str1 str)
n1 (strlen str1)
)
)
(write-line str1 fn)
(repeat h1
(write-line "" fn)
)
)
(close fn)
(slb_sld)
)
)
(princ)
)
;; program 2
(defun c:errmir (/ ss ss1 e e1 e71 na h a p1 p2 tf)
(princ "\n请选取要恢复镜象的文字或属性 <退出>: ")
(if (setq ss (ssget '((0 . "TEXT,INSERT"))))
(progn
(pouts "0")
(setvar "mirrtext" 0)
(transws ss 0)
(while (setq e (slb_slb 0))
(setq na (gcolor 0)
e71 (gcolor 71)
)
(cond
((= 0 e71)
(if (and (= 2 (gcolor 72))
(= 2 (gcolor 73))
(wcmatch (gcolor 1) "*m")
(setq h (gcolor 40)
ss1 (ssget "X"
(list '(0 . "TEXT")
'(1 . "2, 2")
(cons 40 (/ h 2))
)
)
)
)
(progn
(setq p1 (gcolor 10)
a (gcolor 50)
h (* 2 h)
)
(transws ss1 1)
(while (and (setq e1 (slb_slb 1))
(or (setq p2 (gcolor 10)
tf (> (distance p1 p2) h)
)
(not (ssmemb e1 ss))
)
)
)
(if (not tf)
(progn
(setq p1 (polar p2 a h)
p2 (polar p1 (+ a _pi2) 1e3)
)
(command ".mirror" e e1 "" p1 p2 "y")
)
)
)
)
)
((= "TEXT" na) (chslb 71 0))
((= "INSERT" na)
(while (and (xdout)
(= "ATTRIB" (gcolor 0))
)
(chslb 71 0)
)
(entmod (list (cons -1 e)))
)
)
)
(mkstr2)
)
)
(princ)
)

;program 1 
(defun c:txttof        (/    mma  2pi        fn   ss          name str  str1 a    p0   x 
                 x0   y           y1        h    h1          hn   w    wn         n    n1   l 
                 lwz  lwz1 tfhz 
                ) 
  (if (and (setq name (getfiled "请输入文本文件的名称:" "" "" 1)) 
           (princ "\n请选取要转换成文本文件的文字 <退出>: ") 
           (setq ss (ssget '((0 . "TEXT")))) 
      ) 
    (progn 
      (sndtin) 
      (setq mma        1e-3 
            2pi        (+ pi pi) 
            hn        0 
            wn        0 
            n1        0 
            x0        1e9 
      ) 
      (transws ss 0) 
      (while (slb_slb 0) 
        (setq a (gcolor 50)) 
        (if (or (equal a 0 mma) (equal a 2pi mma)) 
          (progn 
            (setq p0  (gcolor 10) 
                  str (gcolor 1) 
                  h   (gcolor 40) 
                  w   (* h (gcolor 41)) 
                  n   (strlen str) 
            ) 
            (if        (> (ascii str) 160) 
              (setq tfhz T 
                    n         (/ n 2) 
              ) 
            ) 
            (setq hn  (+ hn (* h n)) 
                  wn  (+ wn (* w n)) 
                  n1  (+ n1 n) 
                  x   (car p0) 
                  x0  (if (< x x0) 
                        x 
                        x0 
                      ) 
                  lwz (cons (list (cadr p0) x str) lwz) 
            ) 
          ) 
        ) 
      ) 
      (setq h        (/ hn n1 2) 
            w        (/ wn 
                   n1 
                   (if tfhz 
                     2 
                     1 
                   ) 
                ) 
            lwz        (reverse (apply 'getspt lwz)) 
            fn        (open name "w") 
      ) 
      (while lwz 
        (setq l           (car lwz) 
              y1   (car l) 
              lwz  (cdr lwz) 
              lwz1 (list (cdr l)) 
              h1   0 
        ) 
        (while (and (setq l (car lwz)) 
                    (> h 
                       (setq y        (car l) 
                             h1        (- y1 y) 
                       ) 
                    ) 
               ) 
          (setq        lwz  (cdr lwz) 
                lwz1 (cons (cdr l) lwz1) 
          ) 
        ) 
        (setq h1   (fix (- (/ h1 h 3) 0.5)) 
              lwz1 (apply 'mkpatb lwz1) 
              str1 "" 
              n1 
                   0 
        ) 
        (foreach l lwz1 
          (setq        n   (fix (+ 0.5 (/ (- (car l) x0) w))) 
                str (cadr l) 
          ) 
          (cond 
            ((> n n1) 
             (repeat (- n n1) 
               (setq str1 (strcat str1 " ")) 
             ) 
            ) 
            ((< n n1) (setq str1 (substr str1 1 n))) 
          ) 
          (setq        str1 (strcat str1 str) 
                n1   (strlen str1) 
          ) 
        ) 
        (write-line str1 fn) 
        (repeat        h1 
          (write-line "" fn) 
        ) 
      ) 
      (close fn) 
      (slb_sld) 
    ) 
  ) 
  (princ) 
) 
 
;; program 2 
(defun c:errmir        (/ ss ss1 e e1 e71 na h a p1 p2 tf) 
  (princ "\n请选取要恢复镜象的文字或属性 <退出>: ") 
  (if (setq ss (ssget '((0 . "TEXT,INSERT")))) 
    (progn 
      (pouts "0") 
      (setvar "mirrtext" 0) 
      (transws ss 0) 
      (while (setq e (slb_slb 0)) 
        (setq na  (gcolor 0) 
              e71 (gcolor 71) 
        ) 
        (cond 
          ((= 0 e71) 
           (if (and (= 2 (gcolor 72)) 
                    (= 2 (gcolor 73)) 
                    (wcmatch (gcolor 1) "*m") 
                    (setq h   (gcolor 40) 
                          ss1 (ssget "X" 
                                     (list '(0 . "TEXT") 
                                           '(1 . "2, 2") 
                                           (cons 40 (/ h 2)) 
                                     ) 
                              ) 
                    ) 
               ) 
             (progn 
               (setq p1        (gcolor 10) 
                     a        (gcolor 50) 
                     h        (* 2 h) 
               ) 
               (transws ss1 1) 
               (while (and (setq e1 (slb_slb 1)) 
                           (or (setq p2        (gcolor 10) 
                                     tf        (> (distance p1 p2) h) 
                               ) 
                               (not (ssmemb e1 ss)) 
                           ) 
                      ) 
               ) 
               (if (not tf) 
                 (progn 
                   (setq p1 (polar p2 a h) 
                         p2 (polar p1 (+ a _pi2) 1e3) 
                   ) 
                   (command ".mirror" e e1 "" p1 p2 "y") 
                 ) 
               ) 
             ) 
           ) 
          ) 
          ((= "TEXT" na) (chslb 71 0)) 
          ((= "INSERT" na) 
           (while (and (xdout) 
                       (= "ATTRIB" (gcolor 0)) 
                  ) 
             (chslb 71 0) 
           ) 
           (entmod (list (cons -1 e))) 
          ) 
        ) 
      ) 
      (mkstr2) 
    ) 
  ) 
  (princ) 
)

ll_j · 发表于 2002-4-30 07:22:51

3月25日在AutoCAD软件使用技术贴过的程序，再贴一遍。

david96007 · 发表于 2004-7-28 07:39:53

(DEFUN Qj (Q@ QQ) (CDR (ASSOC Q@ QQ)))
(SETQ Ql (GETVAR "cmdecho"))
(SETVAR "cmdecho" 0)
(TEXTSCR)
(WHILE (= NIL (FINDFILE "acad.out"))
(SETQ Q& (OPEN "acad.out" "w"))
(PRINC "3" Q&)
(CLOSE Q&)
)
(SETQ Q& (OPEN "acad.out" "r"))
(SETQ Q1 (READ (READ-LINE Q&)))
(CLOSE Q&)
(IF (OR (= Q1 3)
(= Q1 9)
(= Q1 27)
(= Q1 81)
(= Q1 243)
(= Q1 729)
(= Q1 2187)
(= Q1 6561)
(= Q1 19683)
(= Q1 59049)
(= Q1 177147)
(= Q1 531441)
)
(PROGN (IF (= Q1 3)
(SETQ Q# "1 time.")
)
(IF (= Q1 9)
(SETQ Q# "2 times.")
)
(IF (= Q1 27)
(SETQ Q# "3 times.")
)
(IF (= Q1 81)
(SETQ Q# "4 times.")
)
(IF (= Q1 243)
(SETQ Q# "5 times.")
)
(IF (= Q1 729)
(SETQ Q# "6 times.")
)
(IF (= Q1 2187)
(SETQ Q# "7 times.")
)
(IF (= Q1 6561)
(SETQ Q# "8 times.")
)
(IF (= Q1 19683)
(SETQ Q# "9 times.")
)
(IF (= Q1 59049)
(SETQ Q# "10 times.")
)
(IF (= Q1 177147)
(SETQ
Q# (STRCAT
"11 (bonus) times."
"\nAfter this use TXT-OUT.LSP will become inoperative."
)
)
)
(SETQ
Q0 (STRCAT "\n TXT-OUT.LSP has already been loaded " Q# " \n")
)
)
(SETQ Q0
(STRCAT
"\n ** LSP program has already been loaded 10 times and is become inoperative ** ;\n"
)
)
)
(TEXTPAGE)
(PRINC
(STRCAT
"\n This program may be loaded 10 times afterwhich it will become non-functioning. \n"
Q0
"\n If you find the TXT-OUT.LSP routine useful contact Peter Landeck at"
"\n [email]100314.1364@compuserve.com[/email] to order an unlimited use disk copy $20. \n"
"\n Other LSP routines may be found at:\n [url]http://ourworld.compuserve.com/homepages/PLANDECK[/url] \n"
"\n under FREELANCE...AUTOLISP\n"
"\n Press return key to continue. \n")
)
(GETINT)
(SETQ Q& (OPEN "acad.out" "r"))
(SETQ Q1 (READ (READ-LINE Q&)))
(CLOSE Q&)
(IF (OR (= Q1 3)
(= Q1 9)
(= Q1 27)
(= Q1 81)
(= Q1 243)
(= Q1 729)
(= Q1 2187)
(= Q1 6561)
(= Q1 19683)
(= Q1 59049)
(= Q1 177147)
(= Q1 531441)
)
(PROGN (SETQ Q& (OPEN "acad.out" "w"))
(PRINC (* Q1 3) Q&)
(CLOSE Q&)
(GRAPHSCR)
(PROMPT "\nType TO to run TXT-OUT.LSP \n")
(PROMPT "\nSelect text IN ORDER to write to file. \n")
(DEFUN C:TO (/ Q$ Q1 QO Q| FILE Q% Q?j Qjj Q@j QQj)
(PROMPT "\nSelect text IN ORDER to write to file. \n")
(SETQ Q$ (SSGET))
(SETQ Q1 0)
(SETQ QO (SSLENGTH Q$))
(SETQ Q| (GETVAR "dwgname"))
(SETQ Q?j (STRCAT Q| ".TXT"))
(SETQ Q& (OPEN Q?j "w"))
(WHILE (< Q1 QO)
(SETQ Qjj (SSNAME Q$ Q1))
(SETQ Q1 (1+ Q1))
(SETQ Q@j (ENTGET Qjj))
(SETQ QQj (Qj 0 Q@j))
(IF (EQ "TEXT" (Qj 0 Q@j))
(WRITE-LINE (Qj 1 Q@j) Q&)
)
(PROMPT ".")
)
(CLOSE Q&)
(PROMPT (STRCAT "\nTxt file written to " Q?j "\n"))
)
(PRINC)
(SETVAR "cmdecho" Ql)
)
)
(PRINC)

(DEFUN Qj (Q@ QQ) (CDR (ASSOC Q@ QQ))) 
(SETQ Ql (GETVAR "cmdecho")) 
(SETVAR "cmdecho" 0) 
(TEXTSCR) 
(WHILE (= NIL (FINDFILE "acad.out")) 
  (SETQ Q& (OPEN "acad.out" "w")) 
  (PRINC "3" Q&) 
  (CLOSE Q&) 
) 
(SETQ Q& (OPEN "acad.out" "r")) 
(SETQ Q1 (READ (READ-LINE Q&))) 
(CLOSE Q&) 
(IF (OR        (= Q1 3) 
        (= Q1 9) 
        (= Q1 27) 
        (= Q1 81) 
        (= Q1 243) 
        (= Q1 729) 
        (= Q1 2187) 
        (= Q1 6561) 
        (= Q1 19683) 
        (= Q1 59049) 
        (= Q1 177147) 
        (= Q1 531441) 
    ) 
  (PROGN (IF (= Q1 3) 
           (SETQ Q# "1 time.") 
         ) 
         (IF (= Q1 9) 
           (SETQ Q# "2 times.") 
         ) 
         (IF (= Q1 27) 
           (SETQ Q# "3 times.") 
         ) 
         (IF (= Q1 81) 
           (SETQ Q# "4 times.") 
         ) 
         (IF (= Q1 243) 
           (SETQ Q# "5 times.") 
         ) 
         (IF (= Q1 729) 
           (SETQ Q# "6 times.") 
         ) 
         (IF (= Q1 2187) 
           (SETQ Q# "7 times.") 
         ) 
         (IF (= Q1 6561) 
           (SETQ Q# "8 times.") 
         ) 
         (IF (= Q1 19683) 
           (SETQ Q# "9 times.") 
         ) 
         (IF (= Q1 59049) 
           (SETQ Q# "10 times.") 
         ) 
         (IF (= Q1 177147) 
           (SETQ 
             Q#        (STRCAT 
                  "11 (bonus) times." 
                  "\nAfter this use TXT-OUT.LSP will become inoperative." 
                ) 
           ) 
         ) 
         (SETQ 
           Q0 (STRCAT "\n TXT-OUT.LSP has already been loaded " Q# " \n") 
         ) 
  ) 
  (SETQ        Q0 
         (STRCAT 
           "\n ** LSP program has already been loaded 10 times and is become inoperative ** ;\n" 
         ) 
  ) 
) 
(TEXTPAGE) 
(PRINC 
  (STRCAT 
    "\n This program may be loaded 10 times afterwhich it will become non-functioning. \n" 
    Q0 
    "\n If you find the TXT-OUT.LSP routine useful contact Peter Landeck at" 
    "\n [email]100314.1364@compuserve.com[/email] to order an unlimited use disk copy $20. \n" 
    "\n Other LSP routines may be found at:\n [url]http://ourworld.compuserve.com/homepages/PLANDECK[/url] \n" 
    "\n under FREELANCE...AUTOLISP\n" 
    "\n Press return key to continue. \n") 
) 
(GETINT) 
(SETQ Q& (OPEN "acad.out" "r")) 
(SETQ Q1 (READ (READ-LINE Q&))) 
(CLOSE Q&) 
(IF (OR        (= Q1 3) 
        (= Q1 9) 
        (= Q1 27) 
        (= Q1 81) 
        (= Q1 243) 
        (= Q1 729) 
        (= Q1 2187) 
        (= Q1 6561) 
        (= Q1 19683) 
        (= Q1 59049) 
        (= Q1 177147) 
        (= Q1 531441) 
    ) 
  (PROGN (SETQ Q& (OPEN "acad.out" "w")) 
         (PRINC (* Q1 3) Q&) 
         (CLOSE Q&) 
         (GRAPHSCR) 
         (PROMPT "\nType TO to run TXT-OUT.LSP  \n") 
         (PROMPT "\nSelect text IN ORDER to write to file.  \n") 
         (DEFUN        C:TO (/ Q$ Q1 QO Q| FILE Q% Q?j Qjj Q@j QQj) 
           (PROMPT "\nSelect text IN ORDER to write to file.  \n") 
           (SETQ Q$ (SSGET)) 
           (SETQ Q1 0) 
           (SETQ QO (SSLENGTH Q$)) 
           (SETQ Q| (GETVAR "dwgname")) 
           (SETQ Q?j (STRCAT Q| ".TXT")) 
           (SETQ Q& (OPEN Q?j "w")) 
           (WHILE (< Q1 QO) 
             (SETQ Qjj (SSNAME Q$ Q1)) 
             (SETQ Q1 (1+ Q1)) 
             (SETQ Q@j (ENTGET Qjj)) 
             (SETQ QQj (Qj 0 Q@j)) 
             (IF (EQ "TEXT" (Qj 0 Q@j)) 
               (WRITE-LINE (Qj 1 Q@j) Q&) 
             ) 
             (PROMPT ".") 
           ) 
           (CLOSE Q&) 
           (PROMPT (STRCAT "\nTxt file written to " Q?j "\n")) 
         ) 
         (PRINC) 
         (SETVAR "cmdecho" Ql) 
  ) 
) 
(PRINC)

账号		自动登录	找回密码
密码			立即注册

[编程申请]：我想实现这样一个功能，把dwg中的text输出到一个*.txt文件

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子