各位大神看下，同名文字，后面的数字合并
各位大神看下，同名文字，后面的数字合并jun353835273 发表于 2023-9-2 10:36
用7#楼的思路搞的，源码就用上面的代码补充补充。
谢谢大哥，同时分享给论坛需要的人
(defun C:tj1 ( / aaa ab b boxlst data e e1 e2 entg hight i out pt1pnext pt ss txt x)
(setq ss (ssget (list '(0 . "*TEXT"))))
(setq hight (cdr(assoc 40 (entget (ssname ss 0)))))
(repeat (setq i (sslength ss))
(setq e(ssname ss (setq i (1- i))))
(setq entg (entget e))
(setq pt (cdr(assoc 10 entg)))
(setq txt (cdr(assoc 1 entg)))
(setq boxlst (cons (listtxt pt) boxlst))
)
(setq boxlst(vl-sort boxlst
(function (lambda (e1 e2)
(< (cadadr e1) (cadadr e2)) ) ) ))
(setq data (xl-div boxlst 2));分列
(setq data (mapcar'(lambda(x)(mapcar 'car x ) )data))
(setq data (mapcar '(lambda (x)
(setq a (car x))
(setq b (cadr x))
(if (= (type b) 'STR)
(setq ab (list b (atof a)))
(setq ab (list a (atof b)))
)
)
data
)
)
(setq out (mapcar'(lambda(x)(list(car x)(apply'+(last x))))(subtotals1 data 1) ));分类统计
(setq pt1 (getpoint "\n指定插入点："))
(setq out (reverse out))
(setq aa (mapcar'(lambda(x)(list "" (car x) (rtos (cadr x) 2 2))) out))
(TableLst2Table (append (list '("块缩略图" "块名称" "块数量" )) aa)
(polar pt1 0 3000) 150)
(foreach x out
(setq pnext (polar pt1 0 2000))
(maketxtx (car x) pt1 hight)
(maketxtx (rtos (cadr x) 2 2) pnext hight)
(setq pt1 (polar pt1 (* 1.5 pi) 439));行高
)
(princ)
)
;;函数
(defun subtotals1(lst n / a)
(foreach x lst
(setq a(if(setq b(assoc(car x)a))
(subst(list(car x)(append(last b)(list(nth n x))))b a)
(append a(list(list(car x)(list(nth n x)))))))))
(defun subtotals2(lst m n / a b)
(foreach x lst
(setq a(if(setq b(assoc(nth m x)a))
(subst(list(nth m x)(append(last b)(list(nth n x))))b a)
(append a(list(list(nth m x)(list(nth n x)))))))))
(defun subtotals3 (lst m ns / myfun a b c)
(cond ((= (type ns) 'LIST)
(defun myfun (x) (list (mapcar '(lambda (y) (nth y x)) ns)))
)
((= (type ns) 'INT) (defun myfun (x) (LIST (NTH ns x))))
(t (defun myfun (x) (list (vl-remove c x))))
)
(foreach x lst
(setq a (if (setq c (nth m x)
b (assoc c a)
)
(subst (append b (myfun x)) b a)
(append a (list (append (list c) (myfun x))))
)
)
)
)
;;生成文字
(defun maketxtx (txt p th / )(entmakex (list '(0 . "TEXT") (cons 1 txt)(cons 50 0) (cons 10 p) (cons 11 p)(cons 40 th))))
(defun xl-div (lst x / lst2)
(foreach n lst
(if (and lst2 (/= x (length (car lst2))))
(setq lst2 (cons (append (car lst2) (list n)) (cdr lst2)))
(setq lst2 (cons (list n) lst2))
)
)
(reverse lst2)
)
;利用表格型list制作CAD表格
;参数:
;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)
)
本帖最后由 xj6019 于 2023-9-1 21:36 编辑
慢慢拼，慢慢套呗，我是纯属瞎玩，想用还是找楼上的大佬们定制吧
代码不全，无法使用，仅供参考思路
(defun C:NM (/ col ens getstr p s s1 ss th txtx)
(defun getstr (ent / )(cdr(assoc 1 (entget ent))))
(defun txtx (a p th / )(entmakex (list '(0 . "TEXT") (cons 1 (car a))(cons 50 0)(cons 7 "宋体中文") (cons 10 p) (cons 11 p) (cons 72 0) (cons 73 1) (cons 40 th))))
(setq ss (ssget ":S"(list '(0 . "*TEXT"))))
(setq s(xj-div-lst(mapcar 'getstr(mapcar 'car (setq s1(xj-sort16ss4 0.1 1 T))))2))
(setq s
(mapcar
(function
(lambda(a)
(list (car a)(rtos(apply '+ (mapcar 'atof (cdr a)))2 0))
)
)
(XJ-Btfenlei s)
)
)
(setq p(cdr(assoc 10 (entget (setq ens(caadr s1)))))
p(polar p 0 1500)
th(cdr(assoc 40 (entget ens)))
col(xj-getdxf ens 62)
)
(mapcar
(function
(lambda(a)
(setq p1(polar p 0 2900))
(xj-putdxf (txtx (car a) p th) 62 col)
(xj-putdxf (txtx (cadr a) p1 th) 62 col)
(setq p(polar p (* 1.5 pi) 439))
)
)
s
)
(princ)
)
本帖最后由 cjrun 于 2023-9-2 21:55 编辑
(defun c:t1 ()
(defun ss->list (sset flag / lst)
(foreach x (ssnamex sset)
(if (not (listp (setq x (cadr x))))
(setq lst (cons x lst))
)
)
(if flag
(mapcar 'vlax-ename->vla-object lst)
lst
)
)
(defun delsame (l1 / l2)
(while (setq l2 (cons (car l1) l2)
l1 (vl-remove (car l1) (cdr l1))
)
)
(reverse l2)
)
(setq ss (ssget '(( 0 . "text"))))
(setq ens (ss->list ss nil))
(setq ens1 (vl-remove-if '(lambda (x) (wcmatch (cdr (assoc 1 (entget x))) "#*")) ens))
(setq ens1 (mapcar '(lambda (x) (cons (cdr (assoc 1 (entget x))) (nth 2 (assoc 10 (entget x))))) ens1))
(setq ens2 (vl-remove-if-not '(lambda (x) (wcmatch (cdr (assoc 1 (entget x))) "#*")) ens))
(setq ens2 (mapcar '(lambda (x) (cons (cdr (assoc 1 (entget x)))(nth 2 (assoc 10 (entget x))) )) ens2))
(setq ens3 (delsame (mapcar 'car ens1)))
(setq li(mapcar '(lambda (x) (cons (car x) (mapcar 'car (vl-remove-if-not '(lambda (y) (equal (cdr x)(cdr y) 50)) ens2))) ) ens1))
(mapcar '(lambda (x) (cons x (apply '+ (mapcar 'read (mapcar 'last (vl-remove-if-not '(lambda (y) (= x (car y))) li))))) ) ens3)
) 合并统计
这玩意还有点麻烦，直接用快速看图提取表格，然后表格里面汇总就方便了嘛
本帖最后由 vitalgg 于 2023-9-1 17:31 编辑
https://atlisp.cn/static/videos/text-sum.mp4
需要几个@lisp应用配合来实现。
数学工具、文本工具。
数学工具里有个统计图块名的功能，可以直接选平面图中的块进行统计。
麻烦的很，懒得写，找人定做吧
你应该是来这里找插件的吧，是不是想白嫖:lol？ 两个方法
第一 把这两列用 c2e 提权文字到表格，然后合并统计，再导回来，autocad图元
第二 这两列文字合并，让后用论坛植物统计插件计算就好了 meja 发表于 2023-9-1 21:34
两个方法
第一 把这两列用 c2e 提权文字到表格，然后合并统计，再导回来，autocad图元
第二 这两列文字合 ...
植物统计插件？？
本帖最后由 jun353835273 于 2023-9-2 10:47 编辑
用7#楼的思路搞的，源码就用上面的代码补充补充。