求助批量提取CAD中的文字（TEXT)程序
哪位大神批量提取CAD中的文字（TEXT)的程序啊。上传一个吧 论坛里已有。请楼主仔细找。 老大，找了好久没有找到啊，能传一个吗？谢谢 提取文字后做什么处理？选择没问题。 (defun c:tt ()(setq fnm (if (= (type fnm) 'STR) fnm ""))
(if (and (setq fnm (getfiled "选择输出文件" fnm "txt" 1))
(setq ss (ssget '((0 . "TEXT"))))) (progn
(setq fp (open fnm "w"))
(repeat (setq n (sslength ss))
(setq ent (entget(ssname ss (setq n (1- n)))))
(print(cdr(assoc 1 ent)) fp)
)
(close fp)
))
(princ)
) ;;;wkq004QQ:278416560 2009.02.24 13572449833
(vl-load-com)
(defun c:ZB (/ CENTERCOLOR DIRECTORY E E2
E2L EEL EL FILENAME FL LAYERNAME
MYACADN SS SS2 SS3 SSE START
STRINGXH1 XH2
)
(setvar "cmdecho" 0)
(setq osmode (getvar "osmode"))
(setvar "osmode" 0)
(command "layer" "M" "导出层" "C" 8 "" "")
(setq xh1 1)
(setq xh2 1)
(while (= 1 xh1)
(while (= 1 xh2)
(princ "\n[结束选择(空格/回车/右键)]请点选要导出的圆:")
(if
(setq ss3 (ssget ":S" '((0 . "TEXT"))))
(progn
(setq sse (ssname ss3 0))
(setq eel (entget sse))
(setq layername (cdr (assoc 8 eel)))
(if (setq color (cdr (assoc 62 eel)))
(setq ss2
(ssget
"X"
(list (cons 0 "TEXT")
(cons 8 layername)
(cons 62 color)
)
)
)
(setq
ss2
(ssget "X" (list (cons 0 "TEXT") (cons 8 layername)))
)
)
(setq n 0)
(command ".undo" "begin")
(repeat (sslength ss2)
(setq e2 (ssname ss2 n))
(setq e2l (entget e2))
(setq e2l (subst (cons 8 "导出层") (assoc 8 e2l) e2l))
(setq e2l (subst (cons 62 256) (assoc 62 e2l) e2l))
(entmod e2l)
(setq n (1+ n))
)
(command ".undo" "end")
)
(progn
(setq xh2 0)
)
)
)
(initget 1 "D X E")
(setq start (getreal "\n[退出(E)继续选择(X)]导出请输入(D):"))
(if (= "D" start)
(progn
(if
(setq ss (ssget "X" '((8 . "导出层") (0 . "TEXT"))))
(progn
(setq myacad (vlax-get-acad-object))
(setq filename (vl-filename-base (vla-get-caption myacad)))
(while (vl-file-systime (strcat "c:/" filename ".txt"))
(setq filename (strcat filename "-1"))
)
(setq directory (strcat "c:/" filename ".txt"))
(setq fl (open directory "w"))
(setq n 0)
(repeat (sslength ss)
(setq e (ssname ss n))
(setq el (entget e))
(setq n (1+ n))
(setq center (cdr (assoc 10 el)))
(setq text (cdr (assoc 1 el)))
(setq
string (strcat (setq text (cdr (assoc 1 el)))
",,"
(rtos (car center) 2 3)
","
(rtos (cadr center) 2 3)
","
(rtos (last center) 2 3)
)
)
(write-line string fl)
)
(close fl)
(princ (strcat "\n坐标导出成功" directory))
(setq xh1 0)
)
(progn
(princ "\n在\"导出层\"内没有圆可供导出,程序终止!!")
(setq xh1 0)
)
)
)
(progn
(if (= "X" start)
(setq xh2 1)
(setq xh1 0)
)
)
)
)
(setvar "cmdecho" 1)
(setvar "osmode" osmode)
(princ)
)
;;;取得图层所有文本.
(defun c:outdoc()
(setq fnm (getfiled "保存文件名" "" "doc" 1))
(setq fn (open fnm "w"))
(setq s (ssget))
(setq n (sslength s))
(setq index ( - n 1))
(repeat n
(setq ents (entget (ssname s index)))
(setq index ( - index 1))
(setq ent (assoc 0 ents))
(if ( = "TEXT" (cdr ent))
(progn
(setq txt (cdr (assoc 1 ents)))
(write-line txt fn)
)
)
)
(close fn)
) 谢谢，挺好用的 香田里浪人 发表于 2014-5-25 06:24 static/image/common/back.gif
;;;取得图层所有文本.
(defun c:outdoc()
(setq fnm (getfiled "保存文件名" "" "doc" 1))
老大：
取得图层所有文本. 中不能指定图层，数据乱，
求怎样解决？ 本帖最后由 kozmosovia 于 2016-1-30 21:50 编辑
可以直接使用DATAEXTRACTION命令
页:
[1]