设为首页收藏本站

晓东CAD家园-论坛

 找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 1479|回复: 4

[原创] 发一个多层门窗统计,并生成表格输出的lisp

[复制链接]

签到天数: 62 天

连续签到: 1 天

[LV.6]常住居民II

发表于 2014-8-20 11:10:32 | 显示全部楼层 |阅读模式

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

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

x
虽然天正自带了这个功能,但是只对它本身的门窗有效。但是在画住宅的时候,难免会打很多的户型块,往往这些块我都不会用天正画——一镜像门窗编号也就镜像了。所以在画住宅的时候门窗编号都会单独在户型块外面标。带来的问题就是门窗统计的时候很容易出错。所以做了这样一个多层门窗统计的lisp。

严格来说这个lisp是我做的第二个小程序。由于是半路出家,也没有上过系统的课,就是看着论坛上一些简单的教程慢慢摸索出来的。所以问题还很多:没有报错处理,标准层数量输入负数或者0也能生成,如果是一些门窗附加的文字(比如仅5F有)也会加入统计等等……但至少现在在不故意苛求的情况下能够正常生成表格了。

希望能够抛砖引玉,如果有高手最好对我的各个部分做一个精简(无法理解递归等等的算法思想,但总觉得能写的更优美)。

附上代码,经测试在CAD2010 及 2006版本上均可使用,加载lsp后输入DWB按提示即可。

  1. (defun c:dwb ( / yn selection01 selength01 flnum flnumst winname namest01 namest02 namest03 namest05 namest04 namest06 namest07 namest08 winnum fcb bzcnum namenum winst mczb pt0 pt1 pt2 pt3 xnum ynum intext oldos zn)
  2.     (command "_.undo" "_Group")
  3.     (vl-load-com)
  4.     ;;统计部分
  5.     (while (/= yn "n")
  6.         (princ "\n 请选择标准层 ")
  7.         (setq selection01 (ssget '((0 . "text"))))
  8.         (setq selength01 (sslength selection01))
  9.         (setq flnum (getint "\n 请输入标准层层数(默认一层)"))
  10.         (if (null flnum)
  11.             (setq flnum 1)
  12.         )
  13.         (setq flnumst (cons flnum flnumst))
  14.         ;框选的所有门窗名称
  15.         (while (>= selength01 1)
  16.             (setq selength01 (- selength01 1))
  17.             (setq entname (ssname selection01 selength01 ))
  18.             (setq winname (cdr (assoc 1 (entget entname))))
  19.             (setq namest01 (cons winname namest01))
  20.         )
  21.         (setq namest02 namest01)
  22.         ;去除重复名称
  23.         (while (/= namest02 nil )
  24.             (setq winname (car namest02))
  25.             (setq namest02 (cdr namest02))
  26.             (if (= (member winname namest02) nil)
  27.                 (setq namest03 (cons winname namest03))      
  28.             )
  29.             (if (= (member winname namest05) nil)
  30.                 (setq namest05 (cons winname namest05))
  31.             )
  32.         )
  33.         (setq namest02 namest01)
  34.         ;统计每个门窗在本层上的数量
  35.         (while (/= namest03 nil)
  36.             (setq winname (car namest03))
  37.             (setq namest03 (cdr namest03))
  38.             (setq winnum 0)
  39.             (while (/= (member winname namest02) nil)
  40.                 (setq winnum (+ 1 winnum))
  41.                 (setq namest02 (cdr(member winname namest02)))
  42.             )
  43.             (setq winnum (* winnum flnum))
  44.             (setq namest04 (cons (cons winname winnum) namest04))
  45.             (setq namest02 namest01)
  46.         )
  47.         ;把生成的每层统计表存档
  48.         (setq fcb(cons namest04 fcb))
  49.         (setq yn (getstring "\n 是否继续选择?y继续,n进行最终统计"))
  50.         (if (= yn "N")
  51.             (setq yn "n")
  52.         )
  53.         (if (null yn)
  54.             (setq yn "y")
  55.         )
  56.        (setq flnum ())
  57.        (setq namest01 ())
  58.        (setq namest02 ())
  59.        (setq namest03 ())
  60.        (setq namest04 ())
  61.     )
  62.   
  63.     ;;排序部分
  64.     (while (> (length namest05) 0)
  65.         (setq winname (car namest05))
  66.         (setq namest05 (cdr namest05))
  67.         ;按防火门窗、普通门窗百叶分类
  68.         (cond
  69.             ((wcmatch winname "*/A*") (setq namest01(cons winname namest01)))
  70.             ((wcmatch winname "*/B*") (setq namest02(cons winname namest02)))
  71.             ((wcmatch winname "*/C*") (setq namest03(cons winname namest03)))
  72.             ((wcmatch winname "*G*") (setq namest07(cons winname namest07)))
  73.             ((wcmatch winname "DW*") (setq namest08 (cons winname namest08)))
  74.             ((wcmatch winname "*D*") (setq namest06 (cons winname namest06)))
  75.             ( T (setq namest04(cons winname namest04)))
  76.         )
  77.     )
  78.     ;vl函数排序
  79.     (setq namest01 (vl-sort namest01 '>))
  80.     (setq namest02 (vl-sort namest02 '>))
  81.     (setq namest03 (vl-sort namest03 '>))
  82.     (setq namest04 (vl-sort namest04 '>))
  83.     (setq namest06 (vl-sort namest06 '>))
  84.     (setq namest07 (vl-sort namest07 '>))
  85.     ;组合总表
  86.     (setq namest05 (append namest07 namest04 namest08 namest06 namest03 namest02 namest01))
  87.   
  88.     ;;整理部分,按名称+各楼层数量归档
  89.     (setq fcb (reverse fcb))
  90.     (setq flnumst (reverse flnumst))
  91.     (setq namest02 fcb)
  92.     (setq zn 0)
  93.     (while (/= namest05 ())
  94.         (setq namest02 fcb)
  95.         (setq winname (car namest05))
  96.         (setq namest05 (cdr namest05))
  97.         (setq winst (cons winname winst))
  98.         (setq bzcnum (length flnumst))
  99.         (while (> bzcnum 0)
  100.             (setq namest01 (car namest02))
  101.             (setq namest02 (cdr namest02))
  102.             (setq yn 0)
  103.             (while (= yn 0)
  104.                 (if (=  winname (car (car namest01)))
  105.                     (progn
  106.                         (setq winnum (cdr (car namest01)))  
  107.                         (setq yn 1)            
  108.                     )
  109.                     (progn
  110.                         (setq winnum 0)
  111.                     )
  112.                 )
  113.                 (setq zn (+ zn winnum))
  114.                 (setq namest01 (cdr namest01))
  115.                 (if (= namest01 ())
  116.                    (setq yn 1)
  117.                 )
  118.             )
  119.             (setq winst (cons winnum winst))
  120.             (setq winnum 0)
  121.             (setq bzcnum (- bzcnum 1))
  122.         )
  123.         (setq winst (cons zn winst))
  124.         (setq winst (reverse winst))
  125.         (setq mczb (cons winst mczb))
  126.         (setq winst ())
  127.         (setq zn 0)
  128.     )
  129.   
  130.     ;;输出部分
  131.     (setq pt0 (getpoint "\n 请选取表格左上角"))
  132.     ;构造表格
  133.     (setq oldos (getvar "OSMODE" ))
  134.     (setvar "CMDECHO" 0)
  135.     (setvar "OSMODE" 0)
  136.     (setq pt1 pt0)
  137.     (setq ynum (+ (length fcb) 2))
  138.     (setq xnum (+ (length mczb) 1))  
  139.     (setq pt2 (polar pt1 0 (+ 1500 (* 1100 (- ynum 1)))))
  140.     (command "layer" "s" "0" "")
  141.     (command "line" pt1 pt2 "")
  142.     (command "array" (entlast) "" "" xnum  1 -300 "")
  143.     (setq pt1 pt0)
  144.     (setq xnum (length mczb))
  145.     (setq pt2 (polar pt1 (* 3 (/ pi 2)) (* 300 xnum)))
  146.     (command "line" pt1 pt2 "")
  147.     (setq pt1 (polar pt1 0 1500))
  148.     (setq pt2 (polar pt2 0 1500))
  149.     (command "line" pt1 pt2 "")
  150.     (command "array" (entlast) "" "" 1  ynum 1100 "")
  151.     (setq namest03 flnumst)
  152.     ;输入数据
  153.     (setq pt1 pt0)
  154.     (setq pt2 (polar pt1 (* 3 (/ pi 2)) 225))
  155.     (while (> xnum 0)
  156.         (setq ynum (+ (length fcb) 2))
  157.         (setq namest01 (car mczb))
  158.         (setq mczb (cdr mczb))
  159.         (setq pt3 (polar pt2 0 300))
  160.         (while (> ynum 0)
  161.             (setq intext (car namest01))
  162.             (setq namest01 (cdr namest01))
  163.             (if (= ynum (+ (length fcb) 2))
  164.                 (progn
  165.                     (entmake (list '(0 . "TEXT")  (cons 1 intext) (cons 10 pt3) '(40 . 150) '(7 . "_HZDXC") '(41 . 0.8)))
  166.                     (setq pt3 (polar pt3 0 1400))
  167.                 )
  168.                 (progn
  169.                     (if (/= intext 0)
  170.                         (progn
  171.                             (setq bzcnum (car namest03))
  172.                             (if (null bzcnum)
  173.                                 (setq bzcnum 1)
  174.                             )
  175.                             (if (= bzcnum 1)
  176.                                 (setq intext (itoa intext))
  177.                                 (setq intext (strcat (itoa (/ intext bzcnum)) "X" (itoa bzcnum) "=" (itoa intext)))   
  178.                             )
  179.                             (entmake (list '(0 . "TEXT")  (cons 1 intext) (cons 10 pt3) '(40 . 150) '(7 . "_HZDXC") '(41 . 0.8)))
  180.                         )
  181.                     )
  182.                     (setq namest03 (cdr namest03))
  183.                     (setq pt3 (polar pt3 0 1100))
  184.                 )
  185.             )
  186.             (setq ynum (- ynum 1))
  187.         )
  188.         (setq pt2 (polar pt2 (* 3 (/ pi 2)) 300))
  189.         (setq namest03 flnumst)
  190.         (setq xnum (- xnum 1))
  191.     )
  192.     (setvar "OSMODE" oldos)
  193.     (setvar "CMDECHO" 1)
  194.     (command "_.undo" "_end")
  195. )
  196.    



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

签到天数: 109 天

连续签到: 1 天

[LV.6]常住居民II

已领礼包: 40个

财富等级: 招财进宝

发表于 2014-9-5 00:21:42 | 显示全部楼层
謝謝分享即刻下載增長見識
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

签到天数: 10 天

连续签到: 1 天

[LV.3]偶尔看看II

发表于 2018-10-8 14:12:36 | 显示全部楼层
为什么我运行了之后,只有个空表格,没有数字呢?是CAD问题吗?我用的是CAD2012.
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

签到天数: 1931 天

连续签到: 194 天

[LV.Master]伴坛终老I

已领礼包: 5658个

财富等级: 富甲天下

发表于 2018-10-9 00:04:44 | 显示全部楼层
谢谢分享。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复

使用道具 举报

签到天数: 10 天

连续签到: 1 天

[LV.3]偶尔看看II

已领礼包: 3个

财富等级: 恭喜发财

发表于 2018-10-10 23:44:46 来自手机 | 显示全部楼层
好东西谢谢分享
来自: 微社区
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

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

GMT+8, 2018-12-14 13:07 , Processed in 0.105214 second(s), 33 queries , Gzip On, WinCache On.

Powered by Discuz! X3.4

© 2001-2017 Comsenz Inc.

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