找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 46|回复: 0

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

[复制链接]

已领礼包: 274个

财富等级: 日进斗金

发表于 4 天前 | 显示全部楼层 |阅读模式

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

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

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

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




提供一个半成品程序望高手指教,感谢:
  • (defun c:CBLSTATS ()
  • 求程序,根据图纸示例,框选上面光缆程式,批量生成下方统计表。-1.gif     ; 初始化计数列表
  •     (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)
  • )


需要的功能

需要的功能

半成品程序

半成品程序

按程式统计汇总.zip

40.93 KB, 下载次数: 0, 下载积分: D豆 -1 , 活跃度 1

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2025-10-10 04:04 , Processed in 0.331472 second(s), 32 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2025 Discuz! Team.

快速回复 返回顶部 返回列表