求程序，根据图纸示例，框选上面光缆程式，批量生成下方统计表。
求助，请过路的大师看看这个可以做成批量框选汇总吗？请赐教源码，十分感谢！根据图纸示例，框选上面光缆程式，批量生成下方统计表。
提供一个半成品程序望高手指教，感谢：
[*](defun c:CBLSTATS ()
[*] ; 初始化计数列表
[*] (setq l '())
[*]
[*] ; 选择光缆程式文本
[*] (princ "\n选择光缆程式文本: ")
[*] (setq s (ssget))
[*] (if (null s)
[*] (progn
[*] (princ "\n未选择对象!")
[*] (return)
[*] )
[*] )
[*]
[*] ; 统计光缆程式数量
[*] (setq n (sslength s)
[*] i 0
[*] )
[*] (while (< i n)
[*] (setq e (ssname s i)
[*] d (entget e)
[*] t (cdr (assoc 0 d))
[*] )
[*] ; 只处理TEXT和MTEXT对象
[*] (if (or (= t "TEXT") (= t "MTEXT"))
[*] (progn
[*] (setq c (cdr (assoc 1 d)))
[*] (if (not (null c))
[*] (progn
[*] ; 清理空格
[*] (setq cl c)
[*] (while (= (substr cl 1 1) " ")
[*] (setq cl (substr cl 2 (strlen cl)))
[*] )
[*] (while (= (substr cl (strlen cl) 1) " ")
[*] (setq cl (substr cl 1 (- (strlen cl) 1)))
[*] )
[*]
[*] ; 检查是否已存在该程式
[*] (setq f 0)
[*] (setq j 0)
[*] (while (< j (length l))
[*] (setq x (nth j l))
[*] (if (= (car x) cl)
[*] (progn
[*] ; 更新计数
[*] (setq newitem (list (car x) (+ (cadr x) 1)))
[*] (setq l (subst newitem x l))
[*] (setq f 1)
[*] )
[*] )
[*] (setq j (+ j 1))
[*] )
[*] ; 如果是新程式则添加
[*] (if (= f 0)
[*] (setq l (cons (list cl 1) l))
[*] )
[*] )
[*] )
[*] )
[*] )
[*] (setq i (+ i 1))
[*] )
[*]
[*] ; 无数据则退出
[*] (if (null l)
[*] (progn
[*] (princ "\n无有效数据!")
[*] (return)
[*] )
[*] )
[*]
[*] ; 获取插入点
[*] (princ "\n指定表格插入点: ")
[*] (setq p (getpoint))
[*] (if (null p)
[*] (setq p (list 0 0 0))
[*] )
[*]
[*] ; 表格参数
[*] (setq h 2.5
[*] w1 15
[*] w2 15
[*] w3 10
[*] rh 3
[*] y (cadr p)
[*] tl (car p)
[*] tr (+ (car p) w1 w2 w3)
[*] )
[*]
[*] ; 绘制标题
[*] (command "TEXT" (list (/ (+ tl tr) 2) y 0) h 0 "光缆程式统计" "")
[*] (setq y (- y (* rh 2)))
[*]
[*] ; 绘制表头
[*] (command "TEXT" (list (+ tl (/ w1 2)) y 0) h 0 "程式" "")
[*] (command "TEXT" (list (+ tl w1 (/ w2 2)) y 0) h 0 "分类" "")
[*] (command "TEXT" (list (+ tl w1 w2 (/ w3 2)) y 0) h 0 "数量" "")
[*]
[*] ; 表头线条
[*] (setq sy (+ y rh 1)
[*] ey (- y rh 0.5)
[*] )
[*] (command "LINE" (list tl sy) (list tr sy) "")
[*] (command "LINE" (list tl ey) (list tr ey) "")
[*] (command "LINE" (list (+ tl w1) sy) (list (+ tl w1) ey) "")
[*] (command "LINE" (list (+ tl w1 w2) sy) (list (+ tl w1 w2) ey) "")
[*] (setq y ey)
[*]
[*] ; 分类项
[*] (setq items '("拆管道" "拆架空" "拆引上" "管道" "架空" "引上" "余" "合计"))
[*]
[*] ; 填充表格内容
[*] (setq k 0)
[*] (while (< k (length l))
[*] (setq x (nth k l)
[*] cn (car x)
[*] cq (cadr x)
[*] total 0
[*] sy y
[*] )
[*] (setq m 0)
[*] (while (< m (length items))
[*] (setq it (nth m items)
[*] y (- y rh)
[*] )
[*] ; 填写光缆程式
[*] (if (= m 0)
[*] (command "TEXT" (list (+ tl (/ w1 2)) y 0) h 0 cn "")
[*] (command "TEXT" (list (+ tl (/ w1 2)) y 0) h 0 "" "")
[*] )
[*] ; 填写分类项
[*] (command "TEXT" (list (+ tl w1 (/ w2 2)) y 0) h 0 it "")
[*] ; 填写数量
[*] (if (= it "合计")
[*] (command "TEXT" (list (+ tl w1 w2 (/ w3 2)) y 0) h 0 (rtos total 2 1) "")
[*] (progn
[*] (setq val (* cq 40.5))
[*] (setq total (+ total val))
[*] (command "TEXT" (list (+ tl w1 w2 (/ w3 2)) y 0) h 0 (rtos val 2 1) "")
[*] )
[*] )
[*] (setq m (+ m 1))
[*] )
[*] ; 绘制子表格线条
[*] (setq ey y)
[*] (command "LINE" (list tl sy) (list tl ey) "")
[*] (command "LINE" (list tr sy) (list tr ey) "")
[*] (command "LINE" (list (+ tl w1) sy) (list (+ tl w1) ey) "")
[*] (command "LINE" (list (+ tl w1 w2) sy) (list (+ tl w1 w2) ey) "")
[*] (command "LINE" (list tl ey) (list tr ey) "")
[*] (setq y (- y rh)
[*] k (+ k 1)
[*] )
[*] )
[*]
[*] ; 绘制外边框
[*] (command "LINE" (list tl (cadr p)) (list tl y) "")
[*] (command "LINE" (list tr (cadr p)) (list tr y) "")
[*] (command "LINE" (list tl y) (list tr y) "")
[*]
[*] (princ "\n统计完成!")
[*] (princ)
[*])
学习了{:1_13:} 回复看看{:1_12:} 前来学习学习{:1_12:}{:1_12:}{:1_12:}
页:
[1]