各位大神看下，同名文字，后面的数字合并

664571221

各位大神看下，同名文字，后面的数字合并

664571221

jun353835273 发表于 2023-9-2 10:36
用7#楼的思路搞的，源码就用上面的代码补充补充。

谢谢大哥，同时分享给论坛需要的人
(defun C:tj1 ( / a  aa ab b boxlst data e e1 e2 entg hight i out pt1  pnext 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 (list  txt 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

慢慢拼，慢慢套呗，我是纯属瞎玩，想用还是找楼上的大佬们定制吧
代码不全，无法使用，仅供参考思路
(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-sort16  ss  4 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

(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)
  )

ssyfeng

合并统计

jun353835273

这玩意还有点麻烦，直接用快速看图提取表格，然后表格里面汇总就方便了嘛

vitalgg

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

需要几个@lisp应用配合来实现。
数学工具、文本工具。


数学工具里有个统计图块名的功能，可以直接选平面图中的块进行统计。

花开富贵

麻烦的很，懒得写，找人定做吧

花开富贵

你应该是来这里找插件的吧，是不是想白嫖？

meja

两个方法
第一 把这两列用 c2e 提权文字到表格，然后合并统计，再导回来，autocad图元
第二 这两列文字合并，让后用论坛植物统计插件计算就好了

664571221

meja 发表于 2023-9-1 21:34
两个方法
第一 把这两列用 c2e 提权文字到表格，然后合并统计，再导回来，autocad图元
第二 这两列文字合 ...

植物统计插件？？

jun353835273

用7#楼的思路搞的，源码就用上面的代码补充补充。