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

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