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