求程序，根据图纸示例，框选上面光缆程式，批量生成下方统计表。

相信自己666 · 发表于 2025-10-6 22:28:19

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

求助，请过路的大师看看这个可以做成批量框选汇总吗？请赐教源码，十分感谢！

根据图纸示例，框选上面光缆程式，批量生成下方统计表。

提供一个半成品程序望高手指教，感谢：

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

aiju33 · 发表于 2025-10-12 17:27:53

学习了

dnbcgrass · 发表于 2025-10-13 08:06:22

回复看看

dnbc · 发表于 2025-10-18 08:18:40

前来学习学习

账号		自动登录	找回密码
密码			立即注册

[统计] 求程序，根据图纸示例，框选上面光缆程式，批量生成下方统计表。

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

浏览过的版块