发一个多层门窗统计，并生成表格输出的lisp

开间奶茶店

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

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

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

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

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

(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) <br />     (command "_.undo" "_Group")<br />     (vl-load-com)<br />     ;;统计部分<br />     (while (/= yn "n")<br />         (princ "\n 请选择标准层 ")<br />         (setq selection01 (ssget '((0 . "text"))))<br />         (setq selength01 (sslength selection01))<br />         (setq flnum (getint "\n 请输入标准层层数（默认一层）"))<br />         (if (null flnum)<br />             (setq flnum 1)<br />         )<br />         (setq flnumst (cons flnum flnumst))<br />         ;框选的所有门窗名称<br />         (while (>= selength01 1)<br />             (setq selength01 (- selength01 1))<br />             (setq entname (ssname selection01 selength01 ))<br />             (setq winname (cdr (assoc 1 (entget entname))))<br />             (setq namest01 (cons winname namest01))<br />         )<br />         (setq namest02 namest01)<br />         ;去除重复名称<br />         (while (/= namest02 nil )<br />             (setq winname (car namest02))<br />             (setq namest02 (cdr namest02))<br />             (if (= (member winname namest02) nil)<br />                 (setq namest03 (cons winname namest03))      <br />             )<br />             (if (= (member winname namest05) nil)<br />                 (setq namest05 (cons winname namest05))<br />             )<br />         )<br />         (setq namest02 namest01)<br />         ;统计每个门窗在本层上的数量<br />         (while (/= namest03 nil)<br />             (setq winname (car namest03))<br />             (setq namest03 (cdr namest03))<br />             (setq winnum 0)<br />             (while (/= (member winname namest02) nil)<br />                 (setq winnum (+ 1 winnum))<br />                 (setq namest02 (cdr(member winname namest02)))<br />             )<br />             (setq winnum (* winnum flnum))<br />             (setq namest04 (cons (cons winname winnum) namest04))<br />             (setq namest02 namest01)<br />         )<br />         ;把生成的每层统计表存档<br />         (setq fcb(cons namest04 fcb))<br />         (setq yn (getstring "\n 是否继续选择？y继续，n进行最终统计"))<br />         (if (= yn "N")<br />             (setq yn "n")<br />         )<br />         (if (null yn)<br />             (setq yn "y")<br />         )<br />        (setq flnum ())<br />        (setq namest01 ())<br />        (setq namest02 ())<br />        (setq namest03 ())<br />        (setq namest04 ())<br />     )<br />   <br />     ;;排序部分<br />     (while (> (length namest05) 0)<br />         (setq winname (car namest05))<br />         (setq namest05 (cdr namest05))<br />         ;按防火门窗、普通门窗百叶分类<br />         (cond <br />             ((wcmatch winname "*/A*") (setq namest01(cons winname namest01)))<br />             ((wcmatch winname "*/B*") (setq namest02(cons winname namest02)))<br />             ((wcmatch winname "*/C*") (setq namest03(cons winname namest03)))<br />             ((wcmatch winname "*G*") (setq namest07(cons winname namest07)))<br />             ((wcmatch winname "DW*") (setq namest08 (cons winname namest08)))<br />             ((wcmatch winname "*D*") (setq namest06 (cons winname namest06)))<br />             ( T (setq namest04(cons winname namest04)))<br />         )<br />     )<br />     ;vl函数排序<br />     (setq namest01 (vl-sort namest01 '>))<br />     (setq namest02 (vl-sort namest02 '>))<br />     (setq namest03 (vl-sort namest03 '>))<br />     (setq namest04 (vl-sort namest04 '>))<br />     (setq namest06 (vl-sort namest06 '>))<br />     (setq namest07 (vl-sort namest07 '>))<br />     ;组合总表<br />     (setq namest05 (append namest07 namest04 namest08 namest06 namest03 namest02 namest01))<br />   <br />     ;;整理部分，按名称+各楼层数量归档<br />     (setq fcb (reverse fcb))<br />     (setq flnumst (reverse flnumst))<br />     (setq namest02 fcb)<br />     (setq zn 0)<br />     (while (/= namest05 ())<br />         (setq namest02 fcb)<br />         (setq winname (car namest05))<br />         (setq namest05 (cdr namest05))<br />         (setq winst (cons winname winst))<br />         (setq bzcnum (length flnumst))<br />         (while (> bzcnum 0) <br />             (setq namest01 (car namest02))<br />             (setq namest02 (cdr namest02))<br />             (setq yn 0)<br />             (while (= yn 0)<br />                 (if (=  winname (car (car namest01)))<br />                     (progn <br />                         (setq winnum (cdr (car namest01)))  <br />                         (setq yn 1)            <br />                     )<br />                     (progn<br />                         (setq winnum 0)<br />                     )<br />                 )<br />                 (setq zn (+ zn winnum))<br />                 (setq namest01 (cdr namest01))<br />                 (if (= namest01 ())<br />                    (setq yn 1)<br />                 )<br />             )<br />             (setq winst (cons winnum winst))<br />             (setq winnum 0)<br />             (setq bzcnum (- bzcnum 1))<br />         )<br />         (setq winst (cons zn winst))<br />         (setq winst (reverse winst))<br />         (setq mczb (cons winst mczb))<br />         (setq winst ())<br />         (setq zn 0)<br />     )<br />   <br />     ;;输出部分<br />     (setq pt0 (getpoint "\n 请选取表格左上角"))<br />     ;构造表格<br />     (setq oldos (getvar "OSMODE" ))<br />     (setvar "CMDECHO" 0)<br />     (setvar "OSMODE" 0)<br />     (setq pt1 pt0)<br />     (setq ynum (+ (length fcb) 2))<br />     (setq xnum (+ (length mczb) 1))  <br />     (setq pt2 (polar pt1 0 (+ 1500 (* 1100 (- ynum 1)))))<br />     (command "layer" "s" "0" "")<br />     (command "line" pt1 pt2 "")<br />     (command "array" (entlast) "" "" xnum  1 -300 "")<br />     (setq pt1 pt0)<br />     (setq xnum (length mczb))<br />     (setq pt2 (polar pt1 (* 3 (/ pi 2)) (* 300 xnum)))<br />     (command "line" pt1 pt2 "")<br />     (setq pt1 (polar pt1 0 1500))<br />     (setq pt2 (polar pt2 0 1500))<br />     (command "line" pt1 pt2 "")<br />     (command "array" (entlast) "" "" 1  ynum 1100 "")<br />     (setq namest03 flnumst)<br />     ;输入数据<br />     (setq pt1 pt0)<br />     (setq pt2 (polar pt1 (* 3 (/ pi 2)) 225))<br />     (while (> xnum 0)<br />         (setq ynum (+ (length fcb) 2))<br />         (setq namest01 (car mczb))<br />         (setq mczb (cdr mczb))<br />         (setq pt3 (polar pt2 0 300))<br />         (while (> ynum 0)<br />             (setq intext (car namest01))<br />             (setq namest01 (cdr namest01))<br />             (if (= ynum (+ (length fcb) 2))<br />                 (progn <br />                     (entmake (list '(0 . "TEXT")  (cons 1 intext) (cons 10 pt3) '(40 . 150) '(7 . "_HZDXC") '(41 . 0.8)))<br />                     (setq pt3 (polar pt3 0 1400))<br />                 )<br />                 (progn <br />                     (if (/= intext 0)<br />                         (progn <br />                             (setq bzcnum (car namest03))<br />                             (if (null bzcnum)<br />                                 (setq bzcnum 1)<br />                             )<br />                             (if (= bzcnum 1)<br />                                 (setq intext (itoa intext))<br />                                 (setq intext (strcat (itoa (/ intext bzcnum)) "X" (itoa bzcnum) "=" (itoa intext)))   <br />                             )<br />                             (entmake (list '(0 . "TEXT")  (cons 1 intext) (cons 10 pt3) '(40 . 150) '(7 . "_HZDXC") '(41 . 0.8)))<br />                         )<br />                     )<br />                     (setq namest03 (cdr namest03))<br />                     (setq pt3 (polar pt3 0 1100))<br />                 )<br />             )<br />             (setq ynum (- ynum 1))<br />         )<br />         (setq pt2 (polar pt2 (* 3 (/ pi 2)) 300))<br />         (setq namest03 flnumst)<br />         (setq xnum (- xnum 1))<br />     )<br />     (setvar "OSMODE" oldos)<br />     (setvar "CMDECHO" 1) <br />     (command "_.undo" "_end")<br /> )<br />    

virage7676

謝謝分享即刻下載增長見識

timnis@21cn.com

为什么我运行了之后，只有个空表格，没有数字呢？是CAD问题吗？我用的是CAD2012.

kqqt6236

谢谢分享。

86533045

好东西谢谢分享
来自: 微社区

路与三年

错误: 输入的点对中含有多余的 cdrs        这是怎么回事啊？？

yoyoho

好东西谢谢分享!!!!!!

木易成舟好

xvjiex

感谢楼主分享资料！