求CAD 文本统计插件
麻烦大家谁有这款CAD 文本统计插件的源码，在这先谢谢了！
359321852 发表于 2024-1-29 16:37
显示找不到对象
里面是两个命令，一个是统计块的，一个是统计文字的，你是不是用错命令了 http://bbs.mjtd.com/forum.php?mod=viewthread&tid=179722&highlight=%CD%B3%BC%C6%CE%C4%D7%D6&_dsign=0e69aeac 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 ...
显示找不到对象
(defun c:tj(/ en mpl ss n nn m xx pt0 mpl_new i)
(if *table-zg (princ)(setq *table-zg (* 3 (getvar "DIMSCALE"))));设置模式全局变量,初始默认值=1
(setq ss (ssget '((0 . "INSERT"))))
(or ss (setq ss (ssadd)))
(setq n 0 nn (sslength ss) mpl '())
(while (< n nn)
(setq en (ssname ss n) data (entget en))
(setq n (1+ n))
(setq name (cdr (assoc 2 data)));;;
(setq xx (assoc name mpl))
(if xx
(setq m (cadr xx) m (1+ m) mpl (subst (list name m) xx mpl))
(setq mpl (append (list (list name 1)) mpl))
)
)
(if mpl
(progn
(setq i 0)
(setq mpl_new '())
(foreach x mpl
(setq mpl_new (append (list(cons (setq i (1+ i)) x)) mpl_new))
)
(setq mpl_new (append (list (list "序号" "图块名称" "数量")) (reverse mpl_new)))
(initget 0 "S")
(if (/= (setq pt0 (getpoint (strcat "\n点取表格插入点[设置(S)表格文字高度],当前文字高度:" (rtos *table-zg)))) nil)
(progn
(while (= pt0 "S")
(setq str (strcat "\n(建议高度:"(rtos (* 3 (getvar "DIMSCALE"))) ")" "请输表格文字高度：""<" (rtos *table-zg) ">"))
(if (setq temp (getint str))(setq *table-zg temp));采用新输入值
(initget 0 "S")
(setq pt0 (getpoint (strcat "\n点取表格插入点[设置(S)表格文字高度],当前文字高度:" (rtos *table-zg))))
(if (null pt0)(exit))
)
(if (and pt0 *table-zg)
(TableLst2Table mpl_new pt0 *table-zg)
)
)
)
(princ "/nNothing!")
)
(princ)
)
)
(defun c:tjzf(/ en mpl ss n nn m xx pt0 mpl_new i)
(if *table-zg (princ)(setq *table-zg (* 3 (getvar "DIMSCALE"))));设置模式全局变量,初始默认值=1
(setq ss (ssget '((0 . "text"))))
(or ss (setq ss (ssadd)))
(setq n 0 nn (sslength ss) mpl '())
(while (< n nn)
(setq en (ssname ss n) data (entget en))
(setq n (1+ n))
(setq name (cdr (assoc 1 data)));;;
(setq xx (assoc name mpl))
(if xx
(setq m (cadr xx) m (1+ m) mpl (subst (list name m) xx mpl))
(setq mpl (append (list (list name 1)) mpl))
;(setq m (cdr xx) m (1+ m) mpl (subst (cons name m) xx mpl))
;(setq mpl (cons (cons name 1) mpl))
)
)
(if mpl
(progn
(setq i 0)
(setq mpl_new '())
(foreach x mpl
(setq mpl_new (append (list(cons (setq i (1+ i)) x)) mpl_new))
)
(setq mpl_new (append (list (list "序号" "提取字串" "数量")) (reverse mpl_new)))
(initget 0 "S")
(if (/= (setq pt0 (getpoint (strcat "\n点取表格插入点[设置(S)表格文字高度],当前文字高度:" (rtos *table-zg)))) nil)
(progn
(while (= pt0 "S")
(setq str (strcat "\n(建议高度:"(rtos (* 3 (getvar "DIMSCALE"))) ")" "请输表格文字高度：""<" (rtos *table-zg) ">"))
(if (setq temp (getint str))(setq *table-zg temp));采用新输入值
(initget 0 "S")
(setq pt0 (getpoint (strcat "\n点取表格插入点[设置(S)表格文字高度],当前文字高度:" (rtos *table-zg))))
(if (null pt0)(exit))
)
(if (and pt0 *table-zg)
(TableLst2Table mpl_new pt0 *table-zg)
)
)
)
(princ "/nNothing!")
)
(princ)
)
)
;参数:
;lis --- 表格型list
;pt --- 表格左上角(点)
;zg ---- 字高(数值型)
;测试(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)
(defun TableLst2Table (lis pt zg / emkLine emkText h len1 len2 i h1 w2 tab_h len j w1 w2 wlst p0 p1 txt)
(defun emkLine (p1 p2)
(entmake (list '(0 . "LINE") (cons 8 "DM_文字表格") (cons 10 p1) (cons 11 p2)))
)
(defun emkText (pt str h)
(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)))
)
(setq h (* zg 2) ; 表格高
len1 (length lis) ; 表格行数len1
len2 (apply 'max (mapcar 'length lis)) ; 表格列数len2
p0 (list (car pt) (- (cadr pt) (* 0.5 h))); 定义文字原点
)
(setq lis (mapcar '(lambda (y) (mapcar 'vl-princ-to-string y)) lis)) ; 将表中元素全部变为文本型
; 以下获取列宽表 wlst
(setq i 0 w2 0 wlst '())
(repeat len2
(foreach e lis
(setq txt (nth i e))
(if (not txt) (setq txt "")) ;如果没有字符
(setq w1 (* (+ (strlen txt) 1) zg)); 列宽=(文字长度+1)*zg
(if (> w1 w2) (setq w2 w1)) ;取最大列宽
)
(setq wlst (cons w2 wlst) w2 0 i (1+ i))
)
;以下按行写出文字
(setq wlst (reverse wlst))
(setq i 0 j 0 w1 0 w2 0)
(foreach e lis
(setq h1 (- (cadr p0) (* i h))) ; 文字行的y坐标值
(foreach f e
(setq w1 (nth j wlst) w2 (+ w2 w1))
(setq p1 (list (- (+ (car p0) w2) (* w1 0.5)) h1)) ; 文字插入点
(emkText P1 f zg)
(setq j (1+ j))
)
(setq i (1+ i) j 0 w1 0 w2 0)
)
; 开始绘制竖线
(setq tab_h (* len1 h)) ; 竖线长
(emkLine pt (polar pt (* pi 1.5) tab_h)) ; 绘制左侧第一根竖线
(setq len 0)
(foreach x wlst ; 绘制竖线
(setq len (+ x len) p1 (polar pt 0 len))
(emkLine p1 (polar p1 (* Pi 1.5) tab_h))
)
; 开始绘制横线
(setq i 0 len 0)
(setq len (apply '+ wlst)) ; 横线长度
(repeat (1+ len1) ; 绘制横线
(setq p1 (polar pt (* Pi 1.5) (* i h)) i (1+ i))
(emkLine p1 (polar p1 0 len))
)
(princ)
) 本帖最后由 vitalgg 于 2024-1-30 15:24 编辑
;;加载必要的函数
(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))))
(defun C:stat-txt ()
;; 统计选中的单行文字
(setq res
(stat:stat
(mapcar
'(lambda(x)(text:remove-fmt(text:get-mtext x )))
(pickset:to-list(ssget '((0 . "*text")))))))
;; 对统计结果进行排序car 是对统计项排序，cdr 是对统计数量排序
(setq res (list:sort res '(lambda(x y)
(< (car x)(car y)))))
;;绘制结果表
(table:make (getpoint)
"统计结果"
'("项目" "数量")
(mapcar '(lambda(x)
(list (car x)
(cdr x)))
res)))
想要识别天正，把 (0 . "text") 改成 (0 . "text,tch_text")
想要识别多行文本和天正，把 (0 . "text") 改成 (0 . "*text") 。需要去格式字符。(entity:getdxf x 1)改为(text:remove-fmt(text:get-mtext x))
http://s1.atlisp.cn/static/videos/stat-txt.mp4
做了个类似的
https://mp.weixin.qq.com/s/rCg0X6rD5oA7NF-MXFd1vQ 嘿嘿,这个东西用lisp做起来挺麻烦的,如果有hashmap的话,那就无脑value++就行了 guosheyang 发表于 2024-1-29 21:51
做了个类似的
你这个CAD文本统计插件能给我一份吗？谢谢 感谢分享，挺好用的
页:
[1]