求CAD 文本统计插件

359321852

麻烦大家谁有这款CAD 文本统计插件的源码，在这先谢谢了！

xj6019

359321852 发表于 2024-1-29 16:37
显示找不到对象

里面是两个命令，一个是统计块的，一个是统计文字的，你是不是用错命令了

xj6019

http://bbs.mjtd.com/forum.php?mo ... amp;_dsign=0e69aeac

359321852

xj6019 发表于 2024-1-29 13:18
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=179722&highlight=%CD%B3%BC%C6%CE%C4%D7%D6&_dsign=0e ...

显示找不到对象

2. (defun c:tj(/ en mpl ss n nn m xx pt0 mpl_new i)
   
3.         (if *table-zg (princ)(setq *table-zg (* 3 (getvar "DIMSCALE"))));设置模式全局变量,初始默认值=1
   
4.         (setq ss (ssget '((0 . "INSERT"))))
   
5.         (or ss (setq ss (ssadd)))
   
6.         (setq n 0 nn (sslength ss) mpl '())
   
7.         (while (< n nn)
   
8.                 (setq en (ssname ss n) data (entget en))
   
9.                 (setq n (1+ n))
   
10.                 (setq name (cdr (assoc 2 data)));;;
    
11.                 (setq xx (assoc name mpl))
    
12.                 (if xx
    
13.                         (setq m (cadr xx) m (1+ m) mpl (subst (list name m) xx mpl))
    
14.                         (setq mpl (append (list (list name 1)) mpl))                       
    
15.                 )
    
16.   )
    
17.         (if mpl
    
18.                 (progn
    
19.                         (setq i 0)
    
20.                         (setq mpl_new '())
    
21.                         (foreach x mpl
    
22.                                 (setq mpl_new (append (list(cons (setq i (1+ i)) x)) mpl_new))                               
    
23.                         )                               
    
24.                         (setq mpl_new (append (list (list "序号" "图块名称" "数量")) (reverse mpl_new)))                       
    
25.                         (initget 0 "S")
    
26.                         (if (/= (setq pt0 (getpoint (strcat "\n点取表格插入点[设置(S)表格文字高度],当前文字高度:" (rtos *table-zg)))) nil)
    
27.                                 (progn
    
28.                                         (while (= pt0 "S")
    
29.                                                 (setq str (strcat "\n(建议高度:"(rtos (* 3 (getvar "DIMSCALE"))) ")" "  请输表格文字高度："  "<" (rtos *table-zg) ">"))
    
30.                                                 (if (setq temp (getint str))(setq *table-zg temp));采用新输入值
    
31.                                                 (initget 0 "S")
    
32.                                                 (setq pt0 (getpoint (strcat "\n点取表格插入点[设置(S)表格文字高度],当前文字高度:" (rtos *table-zg))))
    
33.                                                 (if (null pt0)(exit))
    
34.                                         )                               
    
35.                                         (if (and pt0 *table-zg)
    
36.                                                 (TableLst2Table mpl_new pt0 *table-zg)                                               
    
37.                                         )
    
38.                                 )
    
39.                         )
    
40.                         (princ "/nNothing!")               
    
41.                 )
    
42.                 (princ)
    
43.         )
    
44. )
    
45. (defun c:tjzf(/ en mpl ss n nn m xx pt0 mpl_new i)
    
46.         (if *table-zg (princ)(setq *table-zg (* 3 (getvar "DIMSCALE"))));设置模式全局变量,初始默认值=1
    
47.         (setq ss (ssget '((0 . "text"))))
    
48.         (or ss (setq ss (ssadd)))
    
49.         (setq n 0 nn (sslength ss) mpl '())
    
50.         (while (< n nn)
    
51.                 (setq en (ssname ss n) data (entget en))
    
52.                 (setq n (1+ n))
    
53.                 (setq name (cdr (assoc 1 data)));;;
    
54.                 (setq xx (assoc name mpl))
    
55.                 (if xx
    
56.                         (setq m (cadr xx) m (1+ m) mpl (subst (list name m) xx mpl))
    
57.                         (setq mpl (append (list (list name 1)) mpl))
    
58.                         ;(setq m (cdr xx) m (1+ m) mpl (subst (cons name m) xx mpl))
    
59.                         ;(setq mpl (cons (cons name 1) mpl))
    
60.                 )
    
61.   )
    
62.         (if mpl
    
63.                 (progn
    
64.                         (setq i 0)
    
65.                         (setq mpl_new '())
    
66.                         (foreach x mpl
    
67.                                 (setq mpl_new (append (list(cons (setq i (1+ i)) x)) mpl_new))                               
    
68.                         )                               
    
69.                         (setq mpl_new (append (list (list "序号" "提取字串" "数量")) (reverse mpl_new)))                       
    
70.                         (initget 0 "S")
    
71.                         (if (/= (setq pt0 (getpoint (strcat "\n点取表格插入点[设置(S)表格文字高度],当前文字高度:" (rtos *table-zg)))) nil)
    
72.                                 (progn
    
73.                                         (while (= pt0 "S")
    
74.                                                 (setq str (strcat "\n(建议高度:"(rtos (* 3 (getvar "DIMSCALE"))) ")" "  请输表格文字高度："  "<" (rtos *table-zg) ">"))
    
75.                                                 (if (setq temp (getint str))(setq *table-zg temp));采用新输入值
    
76.                                                 (initget 0 "S")
    
77.                                                 (setq pt0 (getpoint (strcat "\n点取表格插入点[设置(S)表格文字高度],当前文字高度:" (rtos *table-zg))))
    
78.                                                 (if (null pt0)(exit))
    
79.                                         )                               
    
80.                                         (if (and pt0 *table-zg)
    
81.                                                 (TableLst2Table mpl_new pt0 *table-zg)                                               
    
82.                                         )
    
83.                                 )
    
84.                         )
    
85.                         (princ "/nNothing!")               
    
86.                 )
    
87.                 (princ)
    
88.         )
    
89. )
    
90. ;参数:
    
91. ;lis --- 表格型list
    
92. ;pt --- 表格左上角(点)
    
93. ;zg ---- 字高(数值型)
    
94. ;测试(TableLst2Table '((1 12 123 1234 12345 123456 1234567 12345678 123456780 1234567890)(1.0 0.0 0.0)(100.0 12345.0 "5551000" "1234")) (getpoint) 10)
    
95. (defun TableLst2Table (lis pt zg / emkLine emkText h len1 len2 i h1 w2 tab_h len j w1 w2 wlst p0 p1 txt)
    
96.   (defun emkLine (p1 p2)
    
97.     (entmake (list '(0 . "LINE") (cons 8 "DM_文字表格") (cons 10 p1) (cons 11 p2)))
    
98.         )
    
99.   (defun emkText (pt str h)
    
100.     (entmake (list '(0 . "TEXT") (cons 1 str) (cons 8 "DM_文字表格") (cons 10 pt) (cons 40 h) (cons 11 pt) (cons 72 1) (cons 73 2)))
     
101.         )
     
102.   (setq h (* zg 2)                             ; 表格高
     
103.                 len1 (length lis)                      ; 表格行数len1
     
104.                 len2 (apply 'max (mapcar 'length lis)) ; 表格列数len2
     
105.                 p0 (list (car pt) (- (cadr pt) (* 0.5 h))); 定义文字原点
     
106.         )
     
107.   (setq lis (mapcar '(lambda (y) (mapcar 'vl-princ-to-string y)) lis)) ; 将表中元素全部变为文本型
     
108.   ; 以下获取列宽表 wlst
     
109.   (setq i 0 w2 0 wlst '())
     
110.   (repeat len2
     
111.     (foreach e lis
     
112.       (setq txt (nth i e))
     
113.       (if (not txt) (setq txt ""))         ;如果没有字符
     
114.       (setq w1 (* (+ (strlen txt) 1) zg))  ; 列宽=(文字长度+1)*zg
     
115.       (if (> w1 w2) (setq w2 w1))          ;取最大列宽
     
116.                 )
     
117.     (setq wlst (cons w2 wlst) w2 0 i (1+ i))
     
118.         )
     
119.   ;以下按行写出文字
     
120.   (setq wlst (reverse wlst))
     
121.   (setq i 0 j 0 w1 0 w2 0)
     
122.   (foreach e lis
     
123.     (setq h1 (- (cadr p0) (* i h)))        ; 文字行的y坐标值
     
124.     (foreach f e
     
125.       (setq w1 (nth j wlst) w2 (+ w2 w1))
     
126.       (setq p1 (list (- (+ (car p0) w2) (* w1 0.5)) h1)) ; 文字插入点
     
127.       (emkText P1 f zg)
     
128.       (setq j (1+ j))
     
129.                 )
     
130.     (setq i (1+ i) j 0 w1 0 w2 0)
     
131.         )
     
132.   ; 开始绘制竖线
     
133.   (setq tab_h (* len1 h))                  ; 竖线长
     
134.   (emkLine pt (polar pt (* pi 1.5) tab_h)) ; 绘制左侧第一根竖线
     
135.   (setq len 0)
     
136.   (foreach x wlst                          ; 绘制竖线
     
137.     (setq len (+ x len) p1 (polar pt 0 len))
     
138.     (emkLine p1 (polar p1 (* Pi 1.5) tab_h))
     
139.         )
     
140.   ; 开始绘制横线
     
141.   (setq i 0 len 0)
     
142.   (setq len (apply '+ wlst))              ; 横线长度
     
143.   (repeat (1+ len1)                       ; 绘制横线
     
144.     (setq p1 (polar pt (* Pi 1.5) (* i h)) i (1+ i))
     
145.     (emkLine p1 (polar p1 0 len))
     
146.         )
     
147.   (princ)
     
148. )

(defun c:tj(/ en mpl ss n nn m xx pt0 mpl_new i)<br />         (if *table-zg (princ)(setq *table-zg (* 3 (getvar "DIMSCALE"))));设置模式全局变量,初始默认值=1<br />         (setq ss (ssget '((0 . "INSERT"))))<br />         (or ss (setq ss (ssadd)))<br />         (setq n 0 nn (sslength ss) mpl '())<br />         (while (< n nn)<br />                 (setq en (ssname ss n) data (entget en))<br />                 (setq n (1+ n))<br />                 (setq name (cdr (assoc 2 data)));;;<br />                 (setq xx (assoc name mpl))<br />                 (if xx<br />                         (setq m (cadr xx) m (1+ m) mpl (subst (list name m) xx mpl))<br />                         (setq mpl (append (list (list name 1)) mpl))                        <br />                 )<br />   )<br />         (if mpl<br />                 (progn<br />                         (setq i 0)<br />                         (setq mpl_new '())<br />                         (foreach x mpl<br />                                 (setq mpl_new (append (list(cons (setq i (1+ i)) x)) mpl_new))                                <br />                         )                                <br />                         (setq mpl_new (append (list (list "序号" "图块名称" "数量")) (reverse mpl_new)))                        <br />                         (initget 0 "S")<br />                         (if (/= (setq pt0 (getpoint (strcat "\n点取表格插入点[设置(S)表格文字高度],当前文字高度:" (rtos *table-zg)))) nil)<br />                                 (progn<br />                                         (while (= pt0 "S")<br />                                                 (setq str (strcat "\n(建议高度:"(rtos (* 3 (getvar "DIMSCALE"))) ")" "  请输表格文字高度："  "<" (rtos *table-zg) ">"))<br />                                                 (if (setq temp (getint str))(setq *table-zg temp));采用新输入值<br />                                                 (initget 0 "S")<br />                                                 (setq pt0 (getpoint (strcat "\n点取表格插入点[设置(S)表格文字高度],当前文字高度:" (rtos *table-zg))))<br />                                                 (if (null pt0)(exit))<br />                                         )                                <br />                                         (if (and pt0 *table-zg)<br />                                                 (TableLst2Table mpl_new pt0 *table-zg)                                                <br />                                         )<br />                                 )<br />                         )<br />                         (princ "/nNothing!")                <br />                 )<br />                 (princ)<br />         )<br /> )<br /> (defun c:tjzf(/ en mpl ss n nn m xx pt0 mpl_new i)<br />         (if *table-zg (princ)(setq *table-zg (* 3 (getvar "DIMSCALE"))));设置模式全局变量,初始默认值=1<br />         (setq ss (ssget '((0 . "text"))))<br />         (or ss (setq ss (ssadd)))<br />         (setq n 0 nn (sslength ss) mpl '())<br />         (while (< n nn)<br />                 (setq en (ssname ss n) data (entget en))<br />                 (setq n (1+ n))<br />                 (setq name (cdr (assoc 1 data)));;;<br />                 (setq xx (assoc name mpl))<br />                 (if xx<br />                         (setq m (cadr xx) m (1+ m) mpl (subst (list name m) xx mpl))<br />                         (setq mpl (append (list (list name 1)) mpl))<br />                         ;(setq m (cdr xx) m (1+ m) mpl (subst (cons name m) xx mpl))<br />                         ;(setq mpl (cons (cons name 1) mpl))<br />                 )<br />   )<br />         (if mpl<br />                 (progn<br />                         (setq i 0)<br />                         (setq mpl_new '())<br />                         (foreach x mpl<br />                                 (setq mpl_new (append (list(cons (setq i (1+ i)) x)) mpl_new))                                <br />                         )                                <br />                         (setq mpl_new (append (list (list "序号" "提取字串" "数量")) (reverse mpl_new)))                        <br />                         (initget 0 "S")<br />                         (if (/= (setq pt0 (getpoint (strcat "\n点取表格插入点[设置(S)表格文字高度],当前文字高度:" (rtos *table-zg)))) nil)<br />                                 (progn<br />                                         (while (= pt0 "S")<br />                                                 (setq str (strcat "\n(建议高度:"(rtos (* 3 (getvar "DIMSCALE"))) ")" "  请输表格文字高度："  "<" (rtos *table-zg) ">"))<br />                                                 (if (setq temp (getint str))(setq *table-zg temp));采用新输入值<br />                                                 (initget 0 "S")<br />                                                 (setq pt0 (getpoint (strcat "\n点取表格插入点[设置(S)表格文字高度],当前文字高度:" (rtos *table-zg))))<br />                                                 (if (null pt0)(exit))<br />                                         )                                <br />                                         (if (and pt0 *table-zg)<br />                                                 (TableLst2Table mpl_new pt0 *table-zg)                                                <br />                                         )<br />                                 )<br />                         )<br />                         (princ "/nNothing!")                <br />                 )<br />                 (princ)<br />         )<br /> )<br /> ;参数:<br /> ;lis --- 表格型list<br /> ;pt --- 表格左上角(点)<br /> ;zg ---- 字高(数值型)<br /> ;测试(TableLst2Table '((1 12 123 1234 12345 123456 1234567 12345678 123456780 1234567890)(1.0 0.0 0.0)(100.0 12345.0 "5551000" "1234")) (getpoint) 10)<br /> (defun TableLst2Table (lis pt zg / emkLine emkText h len1 len2 i h1 w2 tab_h len j w1 w2 wlst p0 p1 txt)<br />   (defun emkLine (p1 p2)<br />     (entmake (list '(0 . "LINE") (cons 8 "DM_文字表格") (cons 10 p1) (cons 11 p2)))<br />         )<br />   (defun emkText (pt str h)<br />     (entmake (list '(0 . "TEXT") (cons 1 str) (cons 8 "DM_文字表格") (cons 10 pt) (cons 40 h) (cons 11 pt) (cons 72 1) (cons 73 2)))<br />         )<br />   (setq h (* zg 2)                             ; 表格高<br />                 len1 (length lis)                      ; 表格行数len1<br />                 len2 (apply 'max (mapcar 'length lis)) ; 表格列数len2<br />                 p0 (list (car pt) (- (cadr pt) (* 0.5 h))); 定义文字原点<br />         )<br />   (setq lis (mapcar '(lambda (y) (mapcar 'vl-princ-to-string y)) lis)) ; 将表中元素全部变为文本型<br />   ; 以下获取列宽表 wlst<br />   (setq i 0 w2 0 wlst '())<br />   (repeat len2<br />     (foreach e lis<br />       (setq txt (nth i e))<br />       (if (not txt) (setq txt ""))         ;如果没有字符<br />       (setq w1 (* (+ (strlen txt) 1) zg))  ; 列宽=(文字长度+1)*zg<br />       (if (> w1 w2) (setq w2 w1))          ;取最大列宽<br />                 )<br />     (setq wlst (cons w2 wlst) w2 0 i (1+ i))<br />         )<br />   ;以下按行写出文字<br />   (setq wlst (reverse wlst))<br />   (setq i 0 j 0 w1 0 w2 0)<br />   (foreach e lis<br />     (setq h1 (- (cadr p0) (* i h)))        ; 文字行的y坐标值<br />     (foreach f e<br />       (setq w1 (nth j wlst) w2 (+ w2 w1))<br />       (setq p1 (list (- (+ (car p0) w2) (* w1 0.5)) h1)) ; 文字插入点<br />       (emkText P1 f zg)<br />       (setq j (1+ j))<br />                 )<br />     (setq i (1+ i) j 0 w1 0 w2 0)<br />         )<br />   ; 开始绘制竖线<br />   (setq tab_h (* len1 h))                  ; 竖线长<br />   (emkLine pt (polar pt (* pi 1.5) tab_h)) ; 绘制左侧第一根竖线<br />   (setq len 0)<br />   (foreach x wlst                          ; 绘制竖线<br />     (setq len (+ x len) p1 (polar pt 0 len))<br />     (emkLine p1 (polar p1 (* Pi 1.5) tab_h))<br />         )<br />   ; 开始绘制横线<br />   (setq i 0 len 0)<br />   (setq len (apply '+ wlst))              ; 横线长度<br />   (repeat (1+ len1)                       ; 绘制横线<br />     (setq p1 (polar pt (* Pi 1.5) (* i h)) i (1+ i))<br />     (emkLine p1 (polar p1 0 len))<br />         )<br />   (princ)<br /> )

vitalgg

1. ;;加载必要的函数
   
2. (progn(vl-load-com)(setq s strcat h"http"o(vlax-create-object (s"win"h".win"h"request.5.1"))v vlax-invoke e eval r read)(v o'open "get" (s h"://""atlisp.""cn/cloud"):vlax-true)(v o'send)(v o'WaitforResponse 1000)(e(r(vlax-get o'ResponseText))))
   
3. 
   
4. (defun C:stat-txt ()
   
5.   ;; 统计选中的单行文字
   
6.   (setq res
   
7.         (stat:stat
   
8.          (mapcar
   
9.           '(lambda(x)(text:remove-fmt(text:get-mtext x )))
   
10.           (pickset:to-list(ssget '((0 . "*text")))))))
    
11.   ;; 对统计结果进行排序  car 是对统计项排序，cdr 是对统计数量排序
    
12.   (setq res (list:sort res '(lambda(x y)
    
13.                              (< (car x)(car y)))))
    
14.   ;;绘制结果表
    
15.   (table:make (getpoint)
    
16.               "统计结果"
    
17.               '("项目" "数量")
    
18.               (mapcar '(lambda(x)
    
19.                         (list (car x)
    
20.                          (cdr x)))
    
21.                       res)))
    

;;加载必要的函数<br /> (progn(vl-load-com)(setq s strcat h"http"o(vlax-create-object (s"win"h".win"h"request.5.1"))v vlax-invoke e eval r read)(v o'open "get" (s h"://""atlisp.""cn/cloud"):vlax-true)(v o'send)(v o'WaitforResponse 1000)(e(r(vlax-get o'ResponseText))))<br /> <br /> (defun C:stat-txt ()<br />   ;; 统计选中的单行文字<br />   (setq res<br />         (stat:stat<br />          (mapcar<br />           '(lambda(x)(text:remove-fmt(text:get-mtext x )))<br />           (pickset:to-list(ssget '((0 . "*text")))))))<br />   ;; 对统计结果进行排序  car 是对统计项排序，cdr 是对统计数量排序<br />   (setq res (list:sort res '(lambda(x y)<br />                              (< (car x)(car y)))))<br />   ;;绘制结果表<br />   (table:make (getpoint)<br />               "统计结果"<br />               '("项目" "数量")<br />               (mapcar '(lambda(x)<br />                         (list (car x)<br />                          (cdr x)))<br />                       res)))<br />

想要识别天正，把 (0 . "text") 改成 (0 . "text,tch_text")
想要识别多行文本和天正，把 (0 . "text") 改成 (0 . "*text") 。需要去格式字符。(entity:getdxf x 1)改为(text:remove-fmt(text:get-mtext x))

如果无法播放，请点击此处在新窗口打开

guosheyang

做了个类似的  

tiancao100

https://mp.weixin.qq.com/s/rCg0X6rD5oA7NF-MXFd1vQ

你有种再说一遍

嘿嘿,这个东西用lisp做起来挺麻烦的,如果有hashmap的话,那就无脑value++就行了

359321852

guosheyang 发表于 2024-1-29 21:51
做了个类似的

你这个CAD文本统计插件能给我一份吗？谢谢

paulpipi

感谢分享，挺好用的