帮忙写个查找图形中所有TEXT文本并以.txt格式导出

kaixinmao

;;修改后的文字统计;
;;编制:刘黑;
;;20050708 (defun GET_LAYER_TEXT1 (/ BKOSMODE CNPT0 CNPT1 I LAYER N RESULT SS X Y)
(setq LAYER (cdr (assoc 8 (entget (car (entsel "\n选择需要统计图层中的任一文字："))))))
(setq BKOSMODE (getvar "osmode"))
(setq CNPT0 (getpoint "\n指定范围，第一点:")
CNPT1 (getcorner CNPT0 "\n指定范围，第二点:"))
(setvar "osmode" BKOSMODE)
(setq SS (ssget "c" CNPT0 CNPT1 (list '(0 . "TEXT") (cons 8 LAYER))))
(setq N (sslength SS)
I 0)
(setq RESULT NIL)
(repeat N
(setq X (cdr (assoc 1 (entget (ssname SS I)))))
(if (null (setq Y (assoc X RESULT)))
(setq RESULT (cons (cons X 1) RESULT))
(progn (setq RESULT (subst (cons X (1+ (cdr Y))) Y RESULT))))
(setq I (1+ I)))
RESULT)
(defun c:lout (/ FH RESULT S)
(setq RESULT (GET_LAYER_TEXT1))
(setq FH (open "C:/textout.txt" "w"))
(write-line "选择图层文字统计结果：" FH)
(foreach X RESULT
(setq S (strcat (car X) " :" (itoa (cdr X))))
(write-line S FH))
(close FH)
(startapp "notepad" "C:/textout.txt")
) 这点字码了半个多小时，期间，查看命令帮助N次。呵呵，

whm2216

kaixinmao您好！你真厉害，这个程序非常好！但我觉得还需要再小小调整一下就完美了：(1)点取某一文字后，不要立刻出现“指定范围”的，应该还是Select objects光标，给人第二次机会(甚至第n次)，直到点取目标文字，之后再用W或C进行窗选某区域（2）执行命令后或指定范围时，捕捉设置取消直到操作完成后再恢复原捕捉（3）见附图，统计的结果如按“名称”排列那就好了。 另外想问一下：你在广州吗？可以见见你吗？(如可以的话)。我的QQ：382570194 Email：gzwhm@yahoo.com.cn

kaixinmao

你的意思是，如果点错了没有点到文字上，可以再点一次，直到点对为之。


我认为可以这么考虑，判断点取的是否文本，不是，则重新点取。是的话，就当是对的了。但是选错文字，不如ESC重新运行。这样不会增加正常操作次序。


至于选择集的范围调整，反而简单化了。


排序问题，如果用vusual lisp的VL_sort会简单，不然，得找一个去。我自己编也行。

kaixinmao

;;再次修改后的文字统计;
;;编制:刘黑;
;;20050709 (defun GET_LAYER_TEXT2 (/ BKOSMODE CNPT0 CNPT1 I LAYER N RESULT SS X Y ENT SEL)
(while (progn (setq SEL (entsel "\n选择需要统计图层中的任一文字："))
(cond ((null SEL) t)
((/= "TEXT" (cdr (assoc 0 (setq ENT (entget (car SEL))))))
t)
(t (progn (setq LAYER (cdr (assoc 8 ENT))) NIL))))
t)
(setq SS (ssget (list '(0 . "TEXT") (cons 8 LAYER))))
(setq N (sslength SS)
I 0)
(setq RESULT NIL)
(repeat N
(setq X (cdr (assoc 1 (entget (ssname SS I)))))
(if (null (setq Y (assoc X RESULT)))
(setq RESULT (cons (cons X 1) RESULT))
(progn (setq RESULT (subst (cons X (1+ (cdr Y))) Y RESULT))))
(setq I (1+ I)))
(vl-sort RESULT
(function (lambda (E1 E2) (< (car E1) (car E2)))))) (defun COUT (/ FH RESULT S)
(setq RESULT (GET_LAYER_TEXT2))
(setq FH (open "C:/textout.txt" "w"))
(write-line "选择图层文字统计结果：" FH)
(foreach X RESULT
(setq S (strcat (car X) " :" (itoa (cdr X))))
(write-line S FH))
(close FH)
(startapp "notepad" "C:/textout.txt")) 如果你用的是老的CAD R12或R14，那个VL-sort也许有点问题。如果用的是2000以上的，大概可以了。

kaixinmao

老版本的把下面的排序插入程序前面就能用了。 (defun LST_INSERT (LST EL FUNC / I J K LS M)
(setq I 0
K 0
J (length LST)
LS NIL)
(if (= 0 J)
(setq LS (list EL))
(progn (while (< I J)
(setq M (nth I LST)
I (1+ I))
(if (= K 0)
(if (FUNC EL M)
(setq LS (cons EL LS)
K 1)))
(setq LS (cons M LS)))
(if (= 0 K)
(setq LS (cons EL LS)))))
(reverse LS))
(defun vl-sort (FUNC LST / NN LS)
(if (listp LST)
(foreach NN LST (setq LS (LST_INSERT LS NN FUNC)))
LST))

userzhl

刘黑老大，可不可做成这样：所生成的文本文件中的字是按所选取的顺序排列的？

kaixinmao

如果选的字少的话，顺序选择排列没有必要，用眼睛也能看出来；选择的字多的话，顺序点取恐怕不合适。


而且“所生成的文本文件中的字是按所选取的顺序排列的”太含糊了。

kaixinmao

一般，lisp编写程序都有很强的针对性的，最常用的是在具体工作中发现的某些需要重复的操作，这个操作使用的人次多，为了提高效率，编制程序替代。

秋枫

排序的问题一般可以用Excel解决。把你TEXT文档中分隔符用TAB替代（一般的文本编辑器的查找替换可以做到）。然后复制到Excel中，针对第一列排序就行了。

whm2216

嗨，kaixinmao你好！很高兴看到你继续跟帖，做得很出色，我想你是个工作很热情的人。有兴趣开发一个全新的特别的建筑软件吗？(我已邀请了多人）能告诉我你的Email吗，我想给你写封信。