材料表重量计算

lostbalance

之前的程序漏了几个调用函数，补充了下。
更新附件的时候，原来的附件被删掉了，新的好像要重新收费。重复消费的短信通知我，我看看怎么退款

=====我=是=分=割=线=====
好老的帖子了，今天有人短消息问我要调用的函数……程序改动好多，调用函数也变动不少，就直接发新版的吧，如果有漏的回帖或者短消息吧。
新版和原版变化不大，主要加了面板功能。

2. ;|= 材料重量计算
   
3. ;|==CalWt
   
4. ;|===
   
5. gvar: *var-calwt*
   
6. ver: [1.0.2] by lostbalance 20160913
   
7. ==========|;
   
8. (defun c:CalWt(/ shell shellv eha ehav hha hhav pipe plate Lsteel setdcl autocal md th a1 a2 a3 a4 b1 b2 b3 c1 c2 c3 d1 d2 d3 d4)
   
9.     ;;=================================计算公式
   
10.     (defun shell (a b c md) (* pi (+ a b) b c md 1e-6))
    
11.     (defun shellv (a c) (* pi a a c 2.5e-10))
    
12.     (defun eha (a b c md) (* pi b (+ (/ (* a a) 3.) (/ (* a b 5.) 6.) (/ (* b b 2.) 3.) (* a c) (* b c)) md 1e-6))
    
13.     (defun ehav (a c) (* pi (+ (/ (* a a a) 24.) (* a a c 0.25)) 1e-9))
    
14.     (defun hha (a b c md) (* pi (+ (* a a b 0.5) (* a b b) (* b b b (/ 2. 3.)) (* a b c) (* b b c)) md 1e-6))
    
15.     (defun hhav (a c) (* pi (+ (* a a a (/ 1. 12.)) (* a a c 0.25)) 1e-9))
    
16.     (defun pipe (a b c md) (* pi (- a b) b c md 1e-6))
    
17.     (defun plate (a b c md) (* a b c md 1e-6))
    
18.     (defun Lsteel ( a b c d md) (* (+ (* a c) (* b c) (* c c -1.) (* a b 0.0025)) d md 1e-6))
    
19.     ;;=================================
    
20.     ;;面板
    
21.     (defun setdcl (/ calw str_lst init_lst infmsg ctl va1 va2 va3 wa1 wa2 wa3 wb wc wd)
    
22.         (setq infmsg
    
23.             (strcat
    
24.                 "材料重量计算(CalWt)"
    
25.                 "\nv1.0.1 20160913"
    
26.                 "\n\n自动计算可根据标记格式自动计算材料重量。"
    
27.                 "\n\n适用的标记格式如下："
    
28.                 "\n    筒体 DN num %%130= num (H= num)"
    
29.                 "\n    椭圆形封头 EHA num X num (H= num)"
    
30.                 "\n    管 %%C num X num (L= num / L≈ num)"
    
31.                 "\n    筒 %%C num X num (L= num / L≈ num)"
    
32.                 "\n    节 %%C num X num (L= num / L≈ num)"
    
33.                 "\n    板 - num X num  (L= num / L≈ num)"
    
34.                 "\n    板 num X num (%%130= num / X num)"
    
35.                 "\n    块 num X num (%%130= num / X num)"
    
36.                 "\n    板 %%C num %%130= num"
    
37.                 "\n    圈 %%C num /%%C num %%130= num"
    
38.                 "\n    环 %%C num /%%C num %%130= num"
    
39.                 "\n    角钢 ∠ num X num X num (L= num / L≈ num)"
    
40.                 "\n    角钢 L num X num X num (L= num / L≈ num)"
    
41.                 "\n    角钢法兰 num X num X num (L= num / L≈ num)"
    
42.                 "\n    角钢 num X num X num (L= num / L≈ num)"
    
43.                 "\n\n注："
    
44.                 "\n    忽略大小写，num代表数字"
    
45.                 "\n    括号"()"表示尺寸支持即时输入"
    
46.                 "\n    斜杠"/"表示尺寸支持多种格式"
    
47.                 "\n\n单位: 长度 <> mm | 容积 <> m3 | 质量 <> kg"
    
48.                 "\n\nDeveloper: lostbalance"
    
49.                 "\nEmail: lostbalance@foxmail.com"
    
50.             )
    
51.         )
    
52.         ;;计算
    
53.         (defun calw (flag / )
    
54.             (setq va1 (shellv a1 a3))
    
55.             (setq wa1 (shell a1 a2 a3 md))
    
56.             (setq va2 (ehav a1 a4))
    
57.             (setq wa2 (eha a1 a2 a4 md))
    
58.             (setq va3 (hhav a1 a4))
    
59.             (setq wa3 (hha a1 a2 a4 md))
    
60.             (setq wb (pipe b1 b2 b3 md))
    
61.             (setq wc (plate c1 c2 c3 md))
    
62.             (setq wd (Lsteel d1 d2 d3 d4 md))
    
63.             (if flag (wyb-set-init (list "va1" va1 "wa1" wa1 "va2" va2 "wa2" wa2 "va3" va3 "wa3" wa3 "wb" wb "wc" wc "wd" wd)))
    
64.         )
    
65.         (calw nil)
    
66.         (setq str_lst
    
67.             '(
    
68.                 ("" "壳体" ":boxed_column{")
    
69.                     ":row{"
    
70.                         ("" "" ":row{" "left")
    
71.                             ("a1" "DN" "real" "(setq a1 (atof $value))(calw t)" "10")
    
72.                             ("a2" "δ=" "real" "(setq a2 (atof $value))(calw t)" "10")
    
73.                         "}"
    
74.                         ("" "" ":row{" "right")
    
75.                             ("" "EHA DN<=2000 h=25; DN>2000 h=40" "text")
    
76.                         "}"
    
77.                     "}"
    
78.                     ":row{"
    
79.                         ("" "" ":row{" "left")
    
80.                             ("a3" "H=" "real" "(setq a3 (atof $value))(calw t)" "10")
    
81.                         "}"
    
82.                         ("" "" ":row{" "right")
    
83.                             ("va1" "筒体  体积   " "real" "" "10")
    
84.                             ("wa1" "质量" "real" "" "10")
    
85.                             ("oa1" "输出" "button" "(done_dialog 2)" "4")
    
86.                         "}"
    
87.                     "}"
    
88.                     ":row{"
    
89.                         ("" "" ":row{" "left")
    
90.                             ("a4" "h=" "real" "(setq a4 (atof $value))(calw t)" "10")
    
91.                         "}"
    
92.                         ("" "" ":row{" "right")
    
93.                             ("va2" "椭封EHA 体积" "real" "" "10")
    
94.                             ("wa2" "质量" "real" "" "10")
    
95.                             ("oa2" "输出" "button" "(done_dialog 3)" "4")
    
96.                         "}"
    
97.                     "}"
    
98.                     ":row{"
    
99.                         ("" "" ":row{" "left")
    
100.                             ("" "HHA 准半球时h为负值" "text")
     
101.                         "}"
     
102.                         ("" "" ":row{" "right")
     
103.                             ("va3" "球封HHA 体积" "real" "" "10")
     
104.                             ("wa3" "质量" "real" "" "10")
     
105.                             ("oa3" "输出" "button" "(done_dialog 4)" "4")
     
106.                         "}"
     
107.                     "}"
     
108.                 "}"
     
109.                 ("" "接管" ":boxed_row{")
     
110.                     ("" "" ":row{" "left")
     
111.                         ("b1" "φ" "real" "(setq b1 (atof $value))(calw t)" "10")
     
112.                         ("b2" "X " "real" "(setq b2 (atof $value))(calw t)" "10")
     
113.                         ("b3" "L=" "real" "(setq b3 (atof $value))(calw t)" "10")
     
114.                     "}"
     
115.                     ("" "" ":row{" "right")
     
116.                         ("wb" "质量" "real" "" "10")
     
117.                         ("ob" "输出" "button" "(done_dialog 5)" "4")
     
118.                     "}"
     
119.                 "}"
     
120.                 ("" "钢板" ":boxed_row{")
     
121.                     ("" "" ":row{" "left")
     
122.                         ("c1" "    " "real" "(setq c1 (atof $value))(calw t)" "10")
     
123.                         ("c2" "X " "real" "(setq c2 (atof $value))(calw t)" "10")
     
124.                         ("c3" "X " "real" "(setq c3 (atof $value))(calw t)" "10")
     
125.                     "}"
     
126.                     ("" "" ":row{" "right")
     
127.                         ("wc" "质量" "real" "" "10")
     
128.                         ("oc" "输出" "button" "(done_dialog 6)" "4")
     
129.                     "}"
     
130.                 "}"
     
131.                 ("" "角钢" ":boxed_row{")
     
132.                     ("" "" ":row{" "left")
     
133.                         ("d1" "∠" "real" "(setq d1 (atof $value))(calw t)" "10")
     
134.                         ("d2" "X " "real" "(setq d2 (atof $value))(calw t)" "10")
     
135.                         ("d3" "X " "real" "(setq d3 (atof $value))(calw t)" "10")
     
136.                         ("d4" "L=" "real" "(setq d4 (atof $value))(calw t)" "10")
     
137.                     "}"
     
138.                     ("" "" ":row{" "right")
     
139.                         ("wd" "质量" "real" "" "10")
     
140.                         ("od" "输出" "button" "(done_dialog 7)" "4")
     
141.                     "}"
     
142.                 "}"
     
143.                 ("" "" ":boxed_row{")
     
144.                     ("" "" ":row{" "left")
     
145.                         ("md" "密度" "real" "(setq md (atof $value))(calw t)" "10")
     
146.                         ("" "g/cm3" "text")
     
147.                         ("md1" "7.85" "radio" "(setq md 7.85)(wyb-set-value (list \\"md\\" \\"7.85\\" \\"md1\\" \\"0\\"))(calw t)")
     
148.                         ("md2" "7.98" "radio" "(setq md 7.98)(wyb-set-value (list \\"md\\" \\"7.98\\" \\"md2\\" \\"0\\"))(calw t)")
     
149.                     "}"
     
150.                     ("" "" ":row{" "right")
     
151.                         ("th" "字高" "real" "" "10")
     
152.                     "}"
     
153.                 "}"
     
154.                 ":row{"
     
155.                     "i"
     
156.                     ("ok" "自动计算(&X)" "button" "(done_dialog 1)" "8")
     
157.                     "c"
     
158.                 "}"
     
159.             ;    "iocr"
     
160.             )
     
161.         )
     
162.         (setq init_lst
     
163.             (list "md" md "th" th
     
164.                 "a1" a1 "a2" a2 "a3" a3 "a4" a4 "va1" va1 "wa1" wa1 "va2" va2 "wa2" wa2 "va3" va3 "wa3" wa3
     
165.                 "b1" b1 "b2" b2 "b3" b3 "wb" wb
     
166.                 "c1" c1 "c2" c2 "c3" c3 "wc" wc
     
167.                 "d1" d1 "d2" d2 "d3" d3 "d4" d4 "wd" wd
     
168.                
     
169.             )
     
170.         )
     
171.         (setq ctl (wyb-dcl-init "材料质量计算 by lostbalance" str_lst init_lst))
     
172.         (setq *var-calwt* (list md th a1 a2 a3 a4 b1 b2 b3 c1 c2 c3 d1 d2 d3 d4))
     
173.         (cond
     
174.             ((= ctl 0))
     
175.             ((= ctl 1)(autocal))
     
176.             ((= ctl 2)(wyb-exportans wa1 th)(redraw)(setdcl))
     
177.             ((= ctl 3)(wyb-exportans wa2 th)(redraw)(setdcl))
     
178.             ((= ctl 4)(wyb-exportans wa3 th)(redraw)(setdcl))
     
179.             ((= ctl 5)(wyb-exportans wb th)(redraw)(setdcl))
     
180.             ((= ctl 6)(wyb-exportans wc th)(redraw)(setdcl))
     
181.             ((= ctl 7)(wyb-exportans wd th)(redraw)(setdcl))
     
182.         )
     
183.     )
     
184.     ;;自动计算程序
     
185.     (defun autocal (/ rule IfNum GetNum str ans)
     
186.         ;;自动计算规则
     
187.         (defun rule (str / a b c d)
     
188.             (cond    ;所有关键词必须大写!
     
189.                 (    (IfNum str (list "筒体" "DN" "%%130=") nil)
     
190.                     (setq a (GetNum "DN"))
     
191.                     (setq b (GetNum "%%130="))
     
192.                     (cond
     
193.                         ((vl-string-search "H=" str) (setq c (GetNum "H=")))
     
194.                         ((setq c (wyb-getdist "\n筒体长度: <3000> " 3000.)))
     
195.                     )
     
196.                     (setq ans (shell a b c md))
     
197.                 )
     
198.                 (    (IfNum str (list "椭圆形封头" "EHA" "X") nil)
     
199.                     (setq a (GetNum "EHA"))
     
200.                     (setq b (GetNum "X"))
     
201.                     (cond
     
202.                         ((vl-string-search "H=" str) (setq c (GetNum "H=")))
     
203.                         ((< a 2000) (setq c 25.))
     
204.                         ((setq c 40.))
     
205.                     )
     
206.                     (setq ans (eha a b c md))
     
207.                 )
     
208.                 (    (or (IfNum str (list "管" "%%C" "X") nil)
     
209.                         (IfNum str (list "筒" "%%C" "X") nil)
     
210.                         (IfNum str (list "节" "%%C" "X") nil)
     
211.                     )
     
212.                     (setq a (GetNum "%%C"))
     
213.                     (setq b (GetNum "X"))
     
214.                     (cond
     
215.                         ((vl-string-search "L=" str) (setq c (GetNum "L=")))
     
216.                         ((vl-string-search "L≈" str) (setq c (GetNum "L≈")))
     
217.                         ((setq c (wyb-getdist "\n管长: <110> " 110.)))
     
218.                     )
     
219.                     (setq ans (pipe a b c md))
     
220.                 )
     
221.                 (    (IfNum str (list "板-" "X") nil)
     
222.                     (setq a (GetNum "板-"))
     
223.                     (setq b (GetNum "X"))
     
224.                     (cond
     
225.                         ((vl-string-search "L=" str) (setq c (GetNum "L=")))
     
226.                         ((vl-string-search "L≈" str) (setq c (GetNum "L≈")))
     
227.                         ((setq c (wyb-getdist "\n第三边长度: <100> " 100.)))
     
228.                     )
     
229.                     (setq ans (plate a b c md))
     
230.                 )
     
231.                 (    (IfNum str (list "板" "X") nil)
     
232.                     (setq a (GetNum "板"))
     
233.                     (setq b (GetNum "X"))
     
234.                     (cond
     
235.                         ((IfNum str (list "%%130=") nil) (setq c (GetNum "%%130=")))
     
236.                         ((IfNum str (list "X") nil) (setq c (GetNum "X")))
     
237.                         ((setq c (wyb-getdist "\n第三边长度: <8> " 8.)))
     
238.                     )
     
239.                     (setq ans (plate a b c md))
     
240.                 )
     
241.                 (    (IfNum str (list "块" "X") nil)
     
242.                     (setq a (GetNum "块"))
     
243.                     (setq b (GetNum "X"))
     
244.                     (cond
     
245.                         ((IfNum str (list "%%130=") nil) (setq c (GetNum "%%130=")))
     
246.                         ((IfNum str (list "X") nil) (setq c (GetNum "X")))
     
247.                         ((setq c (wyb-getdist "\n第三边长度: <8> " 8.)))
     
248.                     )
     
249.                     (setq ans (plate a b c md))
     
250.                 )
     
251.                 (    (IfNum str (list "板" "%%C" "%%130=") (list "/%%C"))
     
252.                     (setq a (GetNum "%%C"))
     
253.                     (setq b (GetNum "%%130="))
     
254.                     (setq ans (pipe a (* a 0.5) b md))
     
255.                 )
     
256.                 (    (or (IfNum str (list "圈" "%%C" "/%%C" "%%130=") nil)
     
257.                         (IfNum str (list "环" "%%C" "/%%C" "%%130=") nil)
     
258.                     )
     
259.                     (setq a (GetNum "%%C"))
     
260.                     (setq b (GetNum "/%%C"))
     
261.                     (setq c (GetNum "%%130="))
     
262.                     (setq ans (pipe a (* (- a b) 0.5) c md))
     
263.                 )
     
264.                 (    (IfNum str (list "角钢" "X") nil)
     
265.                     (cond
     
266.                         ((vl-string-search "角钢∠" str) (setq a (GetNum "角钢∠")))
     
267.                         ((vl-string-search "角钢L" str) (setq a (GetNum "角钢L")))
     
268.                         ((vl-string-search "角钢法兰" str) (setq a (GetNum "角钢法兰")))
     
269.                         ((vl-string-search "角钢" str) (setq a (GetNum "角钢")))
     
270.                     )
     
271.                     (setq b (GetNum "X"))
     
272.                     (if (vl-string-search "X" str) (setq c (GetNum "X")) (setq c b b a))
     
273.                     (cond
     
274.                         ((vl-string-search "L=" str) (setq d (GetNum "L=")))
     
275.                         ((vl-string-search "L≈" str) (setq d (GetNum "L≈")))
     
276.                         ((setq d (wyb-getdist "\n长度: <1000> " 1000.)))
     
277.                     )
     
278.                     (setq ans (Lsteel a b c d md))
     
279.                 )
     
280.             )
     
281.         )
     
282.         ;;根据关键词判断数据是否齐全 lst1需要；lst2排除
     
283.         (defun IfNum (str lst1 lst2 / str1 i key n)
     
284.             (setq n (length lst1))
     
285.             (setq i 0 key t)
     
286.             (while (and key (< i n))
     
287.                 (setq str1 (nth i lst1))
     
288.                 (if (vl-string-search str1 str)
     
289.                     (setq i (1+ i)
     
290.                         str (substr str (+ (vl-string-search str1 str) (1+ (strlen str1))))
     
291.                     )
     
292.                     (setq key nil)
     
293.                 )
     
294.             )
     
295.             (if lst2
     
296.                 (progn
     
297.                     (setq n (length lst2) i 0)
     
298.                     (while (and key (< i n))
     
299.                         (setq str1 (nth i lst2))
     
300.                         (if (vl-string-search str1 str)
     
301.                             (setq key nil)
     
302.                             (setq i (1+ i))
     
303.                         )
     
304.                     )
     
305.                 )
     
306.             )
     
307.             key
     
308.         )
     
309.         ;;根据关键词提取其后的数字，同时截去str关键词前的部分
     
310.         (defun GetNum (str1 / n a)
     
311.             (setq n (1+ (strlen str1)))
     
312.             (setq str (substr str (+ (vl-string-search str1 str) n)))
     
313.             (setq a (atof str))
     
314.         )
     
315.         ;;======================
     
316.         (while (setq str (wyb-entsel "\n选择材料标记: <退出> " '("TEXT" "MTEXT")))
     
317.             (setq str (wyb-get-entdxf 1 (entget (car str))))
     
318.             (setq str (strcase (wyb-str-replace " " "" str))) ;;去空格并转大写
     
319.             (Rule str)
     
320.             (if ans
     
321.                 (progn
     
322.                     (princ (strcat " 材料重量: " (rtos ans 2 3) " kg"))
     
323.                     (wyb-ExportAns ans th)
     
324.                     (setq ans nil str nil)
     
325.                 )
     
326.                 (princ " 不支持该材料标记格式!...")
     
327.             )
     
328.         )
     
329.     )
     
330.     ;;=============================
     
331.     (if (not (vl-consp *var-calwt*)) (setq *var-calwt* '(7.85 4. 2000. 6. 3000. 25. 60.3 5.6 110. 200. 200. 6. 63. 63. 6. 1000.)))
     
332.     (setq md (car *var-calwt*) th (cadr *var-calwt*)
     
333.         a1 (caddr *var-calwt*) a2 (cadddr *var-calwt*) a3 (nth 4 *var-calwt*) a4 (nth 5 *var-calwt*)
     
334.         b1 (nth 6 *var-calwt*) b2 (nth 7 *var-calwt*) b3 (nth 8 *var-calwt*)
     
335.         c1 (nth 9 *var-calwt*) c2 (nth 10 *var-calwt*) c3 (nth 11 *var-calwt*)
     
336.         d1 (nth 12 *var-calwt*) d2 (nth 13 *var-calwt*) d3 (nth 14 *var-calwt*) d4 (nth 15 *var-calwt*)
     
337.     )
     
338.     (wyb-error-init '("cmdecho" 0 "dimzin" 8))
     
339.     (setdcl)
     
340.     (wyb-error-end)
     
341.     (princ)
     
342. )

;|= 材料重量计算<br /> ;|==CalWt<br /> ;|===<br /> gvar: *var-calwt*<br /> ver: [1.0.2] by lostbalance 20160913<br /> ==========|;<br /> (defun c:CalWt(/ shell shellv eha ehav hha hhav pipe plate Lsteel setdcl autocal md th a1 a2 a3 a4 b1 b2 b3 c1 c2 c3 d1 d2 d3 d4)<br />     ;;=================================计算公式<br />     (defun shell (a b c md) (* pi (+ a b) b c md 1e-6))<br />     (defun shellv (a c) (* pi a a c 2.5e-10))<br />     (defun eha (a b c md) (* pi b (+ (/ (* a a) 3.) (/ (* a b 5.) 6.) (/ (* b b 2.) 3.) (* a c) (* b c)) md 1e-6))<br />     (defun ehav (a c) (* pi (+ (/ (* a a a) 24.) (* a a c 0.25)) 1e-9))<br />     (defun hha (a b c md) (* pi (+ (* a a b 0.5) (* a b b) (* b b b (/ 2. 3.)) (* a b c) (* b b c)) md 1e-6))<br />     (defun hhav (a c) (* pi (+ (* a a a (/ 1. 12.)) (* a a c 0.25)) 1e-9))<br />     (defun pipe (a b c md) (* pi (- a b) b c md 1e-6))<br />     (defun plate (a b c md) (* a b c md 1e-6))<br />     (defun Lsteel ( a b c d md) (* (+ (* a c) (* b c) (* c c -1.) (* a b 0.0025)) d md 1e-6))<br />     ;;=================================<br />     ;;面板<br />     (defun setdcl (/ calw str_lst init_lst infmsg ctl va1 va2 va3 wa1 wa2 wa3 wb wc wd)<br />         (setq infmsg <br />             (strcat <br />                 "材料重量计算(CalWt)"<br />                 "\nv1.0.1 20160913"<br />                 "\n\n自动计算可根据标记格式自动计算材料重量。"<br />                 "\n\n适用的标记格式如下："<br />                 "\n    筒体 DN num %%130= num (H= num)"<br />                 "\n    椭圆形封头 EHA num X num (H= num)"<br />                 "\n    管 %%C num X num (L= num / L≈ num)"<br />                 "\n    筒 %%C num X num (L= num / L≈ num)"<br />                 "\n    节 %%C num X num (L= num / L≈ num)"<br />                 "\n    板 - num X num  (L= num / L≈ num)"<br />                 "\n    板 num X num (%%130= num / X num)"<br />                 "\n    块 num X num (%%130= num / X num)"<br />                 "\n    板 %%C num %%130= num"<br />                 "\n    圈 %%C num /%%C num %%130= num"<br />                 "\n    环 %%C num /%%C num %%130= num"<br />                 "\n    角钢 ∠ num X num X num (L= num / L≈ num)"<br />                 "\n    角钢 L num X num X num (L= num / L≈ num)"<br />                 "\n    角钢法兰 num X num X num (L= num / L≈ num)"<br />                 "\n    角钢 num X num X num (L= num / L≈ num)"<br />                 "\n\n注："<br />                 "\n    忽略大小写，num代表数字"<br />                 "\n    括号"()"表示尺寸支持即时输入"<br />                 "\n    斜杠"/"表示尺寸支持多种格式"<br />                 "\n\n单位: 长度 <> mm | 容积 <> m3 | 质量 <> kg"<br />                 "\n\nDeveloper: lostbalance"<br />                 "\nEmail: lostbalance@foxmail.com"<br />             )<br />         )<br />         ;;计算<br />         (defun calw (flag / )<br />             (setq va1 (shellv a1 a3))<br />             (setq wa1 (shell a1 a2 a3 md))<br />             (setq va2 (ehav a1 a4))<br />             (setq wa2 (eha a1 a2 a4 md))<br />             (setq va3 (hhav a1 a4))<br />             (setq wa3 (hha a1 a2 a4 md))<br />             (setq wb (pipe b1 b2 b3 md))<br />             (setq wc (plate c1 c2 c3 md))<br />             (setq wd (Lsteel d1 d2 d3 d4 md))<br />             (if flag (wyb-set-init (list "va1" va1 "wa1" wa1 "va2" va2 "wa2" wa2 "va3" va3 "wa3" wa3 "wb" wb "wc" wc "wd" wd)))<br />         )<br />         (calw nil)<br />         (setq str_lst<br />             '(<br />                 ("" "壳体" ":boxed_column{")<br />                     ":row{"<br />                         ("" "" ":row{" "left")<br />                             ("a1" "DN" "real" "(setq a1 (atof $value))(calw t)" "10")<br />                             ("a2" "δ=" "real" "(setq a2 (atof $value))(calw t)" "10")<br />                         "}"<br />                         ("" "" ":row{" "right")<br />                             ("" "EHA DN<=2000 h=25; DN>2000 h=40" "text")<br />                         "}"<br />                     "}"<br />                     ":row{"<br />                         ("" "" ":row{" "left")<br />                             ("a3" "H=" "real" "(setq a3 (atof $value))(calw t)" "10")<br />                         "}"<br />                         ("" "" ":row{" "right")<br />                             ("va1" "筒体  体积   " "real" "" "10")<br />                             ("wa1" "质量" "real" "" "10")<br />                             ("oa1" "输出" "button" "(done_dialog 2)" "4")<br />                         "}"<br />                     "}"<br />                     ":row{"<br />                         ("" "" ":row{" "left")<br />                             ("a4" "h=" "real" "(setq a4 (atof $value))(calw t)" "10")<br />                         "}"<br />                         ("" "" ":row{" "right")<br />                             ("va2" "椭封EHA 体积" "real" "" "10")<br />                             ("wa2" "质量" "real" "" "10")<br />                             ("oa2" "输出" "button" "(done_dialog 3)" "4")<br />                         "}"<br />                     "}"<br />                     ":row{"<br />                         ("" "" ":row{" "left")<br />                             ("" "HHA 准半球时h为负值" "text")<br />                         "}"<br />                         ("" "" ":row{" "right")<br />                             ("va3" "球封HHA 体积" "real" "" "10")<br />                             ("wa3" "质量" "real" "" "10")<br />                             ("oa3" "输出" "button" "(done_dialog 4)" "4")<br />                         "}"<br />                     "}"<br />                 "}"<br />                 ("" "接管" ":boxed_row{")<br />                     ("" "" ":row{" "left")<br />                         ("b1" "φ" "real" "(setq b1 (atof $value))(calw t)" "10")<br />                         ("b2" "X " "real" "(setq b2 (atof $value))(calw t)" "10")<br />                         ("b3" "L=" "real" "(setq b3 (atof $value))(calw t)" "10")<br />                     "}"<br />                     ("" "" ":row{" "right")<br />                         ("wb" "质量" "real" "" "10")<br />                         ("ob" "输出" "button" "(done_dialog 5)" "4")<br />                     "}"<br />                 "}"<br />                 ("" "钢板" ":boxed_row{")<br />                     ("" "" ":row{" "left")<br />                         ("c1" "    " "real" "(setq c1 (atof $value))(calw t)" "10")<br />                         ("c2" "X " "real" "(setq c2 (atof $value))(calw t)" "10")<br />                         ("c3" "X " "real" "(setq c3 (atof $value))(calw t)" "10")<br />                     "}"<br />                     ("" "" ":row{" "right")<br />                         ("wc" "质量" "real" "" "10")<br />                         ("oc" "输出" "button" "(done_dialog 6)" "4")<br />                     "}"<br />                 "}"<br />                 ("" "角钢" ":boxed_row{")<br />                     ("" "" ":row{" "left")<br />                         ("d1" "∠" "real" "(setq d1 (atof $value))(calw t)" "10")<br />                         ("d2" "X " "real" "(setq d2 (atof $value))(calw t)" "10")<br />                         ("d3" "X " "real" "(setq d3 (atof $value))(calw t)" "10")<br />                         ("d4" "L=" "real" "(setq d4 (atof $value))(calw t)" "10")<br />                     "}"<br />                     ("" "" ":row{" "right")<br />                         ("wd" "质量" "real" "" "10")<br />                         ("od" "输出" "button" "(done_dialog 7)" "4")<br />                     "}"<br />                 "}"<br />                 ("" "" ":boxed_row{")<br />                     ("" "" ":row{" "left")<br />                         ("md" "密度" "real" "(setq md (atof $value))(calw t)" "10")<br />                         ("" "g/cm3" "text")<br />                         ("md1" "7.85" "radio" "(setq md 7.85)(wyb-set-value (list \\"md\\" \\"7.85\\" \\"md1\\" \\"0\\"))(calw t)")<br />                         ("md2" "7.98" "radio" "(setq md 7.98)(wyb-set-value (list \\"md\\" \\"7.98\\" \\"md2\\" \\"0\\"))(calw t)")<br />                     "}"<br />                     ("" "" ":row{" "right")<br />                         ("th" "字高" "real" "" "10")<br />                     "}"<br />                 "}"<br />                 ":row{"<br />                     "i"<br />                     ("ok" "自动计算(&X)" "button" "(done_dialog 1)" "8")<br />                     "c"<br />                 "}"<br />             ;    "iocr"<br />             )<br />         )<br />         (setq init_lst <br />             (list "md" md "th" th<br />                 "a1" a1 "a2" a2 "a3" a3 "a4" a4 "va1" va1 "wa1" wa1 "va2" va2 "wa2" wa2 "va3" va3 "wa3" wa3<br />                 "b1" b1 "b2" b2 "b3" b3 "wb" wb<br />                 "c1" c1 "c2" c2 "c3" c3 "wc" wc<br />                 "d1" d1 "d2" d2 "d3" d3 "d4" d4 "wd" wd<br />                 <br />             )<br />         )<br />         (setq ctl (wyb-dcl-init "材料质量计算 by lostbalance" str_lst init_lst))<br />         (setq *var-calwt* (list md th a1 a2 a3 a4 b1 b2 b3 c1 c2 c3 d1 d2 d3 d4))<br />         (cond <br />             ((= ctl 0))<br />             ((= ctl 1)(autocal))<br />             ((= ctl 2)(wyb-exportans wa1 th)(redraw)(setdcl))<br />             ((= ctl 3)(wyb-exportans wa2 th)(redraw)(setdcl))<br />             ((= ctl 4)(wyb-exportans wa3 th)(redraw)(setdcl))<br />             ((= ctl 5)(wyb-exportans wb th)(redraw)(setdcl))<br />             ((= ctl 6)(wyb-exportans wc th)(redraw)(setdcl))<br />             ((= ctl 7)(wyb-exportans wd th)(redraw)(setdcl))<br />         )<br />     )<br />     ;;自动计算程序<br />     (defun autocal (/ rule IfNum GetNum str ans)<br />         ;;自动计算规则<br />         (defun rule (str / a b c d)<br />             (cond    ;所有关键词必须大写!<br />                 (    (IfNum str (list "筒体" "DN" "%%130=") nil)<br />                     (setq a (GetNum "DN"))<br />                     (setq b (GetNum "%%130="))<br />                     (cond<br />                         ((vl-string-search "H=" str) (setq c (GetNum "H=")))<br />                         ((setq c (wyb-getdist "\n筒体长度: <3000> " 3000.)))<br />                     )<br />                     (setq ans (shell a b c md))<br />                 )<br />                 (    (IfNum str (list "椭圆形封头" "EHA" "X") nil)<br />                     (setq a (GetNum "EHA"))<br />                     (setq b (GetNum "X"))<br />                     (cond<br />                         ((vl-string-search "H=" str) (setq c (GetNum "H=")))<br />                         ((< a 2000) (setq c 25.))<br />                         ((setq c 40.))<br />                     )<br />                     (setq ans (eha a b c md))<br />                 )<br />                 (    (or (IfNum str (list "管" "%%C" "X") nil) <br />                         (IfNum str (list "筒" "%%C" "X") nil)<br />                         (IfNum str (list "节" "%%C" "X") nil)<br />                     )<br />                     (setq a (GetNum "%%C"))<br />                     (setq b (GetNum "X"))<br />                     (cond<br />                         ((vl-string-search "L=" str) (setq c (GetNum "L=")))<br />                         ((vl-string-search "L≈" str) (setq c (GetNum "L≈")))<br />                         ((setq c (wyb-getdist "\n管长: <110> " 110.)))<br />                     )<br />                     (setq ans (pipe a b c md))<br />                 )<br />                 (    (IfNum str (list "板-" "X") nil)<br />                     (setq a (GetNum "板-"))<br />                     (setq b (GetNum "X"))<br />                     (cond<br />                         ((vl-string-search "L=" str) (setq c (GetNum "L=")))<br />                         ((vl-string-search "L≈" str) (setq c (GetNum "L≈")))<br />                         ((setq c (wyb-getdist "\n第三边长度: <100> " 100.)))<br />                     )<br />                     (setq ans (plate a b c md))<br />                 )<br />                 (    (IfNum str (list "板" "X") nil)<br />                     (setq a (GetNum "板"))<br />                     (setq b (GetNum "X"))<br />                     (cond<br />                         ((IfNum str (list "%%130=") nil) (setq c (GetNum "%%130=")))<br />                         ((IfNum str (list "X") nil) (setq c (GetNum "X")))<br />                         ((setq c (wyb-getdist "\n第三边长度: <8> " 8.)))<br />                     )<br />                     (setq ans (plate a b c md))<br />                 )<br />                 (    (IfNum str (list "块" "X") nil)<br />                     (setq a (GetNum "块"))<br />                     (setq b (GetNum "X"))<br />                     (cond<br />                         ((IfNum str (list "%%130=") nil) (setq c (GetNum "%%130=")))<br />                         ((IfNum str (list "X") nil) (setq c (GetNum "X")))<br />                         ((setq c (wyb-getdist "\n第三边长度: <8> " 8.)))<br />                     )<br />                     (setq ans (plate a b c md))<br />                 )<br />                 (    (IfNum str (list "板" "%%C" "%%130=") (list "/%%C"))<br />                     (setq a (GetNum "%%C"))<br />                     (setq b (GetNum "%%130="))<br />                     (setq ans (pipe a (* a 0.5) b md))<br />                 )<br />                 (    (or (IfNum str (list "圈" "%%C" "/%%C" "%%130=") nil)<br />                         (IfNum str (list "环" "%%C" "/%%C" "%%130=") nil)<br />                     )<br />                     (setq a (GetNum "%%C"))<br />                     (setq b (GetNum "/%%C"))<br />                     (setq c (GetNum "%%130="))<br />                     (setq ans (pipe a (* (- a b) 0.5) c md))<br />                 )<br />                 (    (IfNum str (list "角钢" "X") nil)<br />                     (cond<br />                         ((vl-string-search "角钢∠" str) (setq a (GetNum "角钢∠")))<br />                         ((vl-string-search "角钢L" str) (setq a (GetNum "角钢L")))<br />                         ((vl-string-search "角钢法兰" str) (setq a (GetNum "角钢法兰")))<br />                         ((vl-string-search "角钢" str) (setq a (GetNum "角钢")))<br />                     )<br />                     (setq b (GetNum "X"))<br />                     (if (vl-string-search "X" str) (setq c (GetNum "X")) (setq c b b a))<br />                     (cond<br />                         ((vl-string-search "L=" str) (setq d (GetNum "L=")))<br />                         ((vl-string-search "L≈" str) (setq d (GetNum "L≈")))<br />                         ((setq d (wyb-getdist "\n长度: <1000> " 1000.)))<br />                     )<br />                     (setq ans (Lsteel a b c d md))<br />                 )<br />             )<br />         )<br />         ;;根据关键词判断数据是否齐全 lst1需要；lst2排除<br />         (defun IfNum (str lst1 lst2 / str1 i key n)<br />             (setq n (length lst1))<br />             (setq i 0 key t)<br />             (while (and key (< i n))<br />                 (setq str1 (nth i lst1))<br />                 (if (vl-string-search str1 str)<br />                     (setq i (1+ i)<br />                         str (substr str (+ (vl-string-search str1 str) (1+ (strlen str1))))<br />                     )<br />                     (setq key nil)<br />                 )<br />             )<br />             (if lst2<br />                 (progn<br />                     (setq n (length lst2) i 0)<br />                     (while (and key (< i n))<br />                         (setq str1 (nth i lst2))<br />                         (if (vl-string-search str1 str)<br />                             (setq key nil)<br />                             (setq i (1+ i))<br />                         )<br />                     )<br />                 )<br />             )<br />             key<br />         )<br />         ;;根据关键词提取其后的数字，同时截去str关键词前的部分<br />         (defun GetNum (str1 / n a)<br />             (setq n (1+ (strlen str1)))<br />             (setq str (substr str (+ (vl-string-search str1 str) n)))<br />             (setq a (atof str))<br />         )<br />         ;;======================<br />         (while (setq str (wyb-entsel "\n选择材料标记: <退出> " '("TEXT" "MTEXT")))<br />             (setq str (wyb-get-entdxf 1 (entget (car str))))<br />             (setq str (strcase (wyb-str-replace " " "" str))) ;;去空格并转大写<br />             (Rule str)<br />             (if ans <br />                 (progn <br />                     (princ (strcat " 材料重量: " (rtos ans 2 3) " kg"))<br />                     (wyb-ExportAns ans th) <br />                     (setq ans nil str nil)<br />                 )<br />                 (princ " 不支持该材料标记格式!...")<br />             )<br />         )<br />     )<br />     ;;=============================<br />     (if (not (vl-consp *var-calwt*)) (setq *var-calwt* '(7.85 4. 2000. 6. 3000. 25. 60.3 5.6 110. 200. 200. 6. 63. 63. 6. 1000.)))<br />     (setq md (car *var-calwt*) th (cadr *var-calwt*)<br />         a1 (caddr *var-calwt*) a2 (cadddr *var-calwt*) a3 (nth 4 *var-calwt*) a4 (nth 5 *var-calwt*)<br />         b1 (nth 6 *var-calwt*) b2 (nth 7 *var-calwt*) b3 (nth 8 *var-calwt*)<br />         c1 (nth 9 *var-calwt*) c2 (nth 10 *var-calwt*) c3 (nth 11 *var-calwt*)<br />         d1 (nth 12 *var-calwt*) d2 (nth 13 *var-calwt*) d3 (nth 14 *var-calwt*) d4 (nth 15 *var-calwt*)<br />     )<br />     (wyb-error-init '("cmdecho" 0 "dimzin" 8))<br />     (setdcl)<br />     (wyb-error-end)<br />     (princ)<br /> )

=====我=是=分=割=线=====
这两天编了个材料表重量计算的程序，可以根据特定的关键词自动计算质量。
水平有限，有兴趣的可以优化下。另外，个人觉得可以程序可以改造成多选后，自动根据材料确定密度等参数，操作计算整个数据表，不过我所在的化工专业，材料表的很多材料只有一个名称，反而会影响效率，所以就不在这方面深化了。
另外，源码中涉及的调用函数，根据函数名，论坛里找一下或者自己写下吧，我就不贴了。
ps：公司做好的演示图正好超了4M，就打包了下。。。

2. ;;CalWt自动计算标准格式的材料质量
   
3. ;;by woyb
   
4. (defun c:CalWt( / Setup IfNum GetNum txh str md nlst a b c ans)
   
5.   ;根据关键词判断数据是否齐全
   
6.   (defun IfNum (str lst1 lst2 / str1 i key n)
   
7.     (setq n (length lst1))
   
8.     (setq i 0 key t)
   
9.     (while (and key (< i n))
   
10.       (setq str1 (nth i lst1))
    
11.       (if (vl-string-search str1 str)
    
12.         (progn
    
13.           (setq i (1+ i))
    
14.           (setq str (substr str (+ (vl-string-search str1 str) (1+ (strlen str1)))))
    
15.         )
    
16.         (setq key nil)
    
17.       )
    
18.     )
    
19.     (if lst2
    
20.       (progn
    
21.         (setq n (length lst2))
    
22.         (setq i 0)
    
23.         (while (and key (< i n))
    
24.           (setq str1 (nth i lst2))
    
25.           (if (vl-string-search str1 str)
    
26.             (setq key nil)
    
27.             (setq i (1+ i))
    
28.           )
    
29.         )
    
30.       )
    
31.     )
    
32.     key
    
33.   )
    
34.   ;提取关键词后的字符，并转化数字
    
35.   (defun GetNum (str1 / n a)
    
36.     (setq n (1+ (strlen str1)))
    
37.     (setq str (substr str (+ (vl-string-search str1 str) n)))
    
38.     (setq a (atof str))
    
39.   )
    
40.   ;取值函数
    
41.   (defun Setup()
    
42.     (initget "s d f")
    
43.     (setq md (getreal (strcat "\n密度g/cm3 或 设置字高[S] 7.85[D] 7.98[F]: <" (rtos ACW-md)">")))
    
44.     (cond
    
45.       ((= md "s")
    
46.         (setq txh (getreal (strcat "\n写入重量的文字高度: <"(rtos ACW-txh)"> ")))
    
47.         (if txh (setq ACW-txh txh) (setq txh ACW-txh))
    
48.         (Setup)
    
49.       )
    
50.       ((= md "d") (setq md 7.85) (setq ACW-md 7.85))
    
51.       ((= md "f") (setq md 7.98) (setq ACW-md 7.98))
    
52.       (md (setq ACW-md md))
    
53.       ((setq md ACW-md))
    
54.     )
    
55.   )
    
56.   (if (not cal) (princ "\ncal..."))
    
57.   (princ "\n计算标准标记格式的材料重量: ")
    
58.   (WYB-CMD0)
    
59.   (setq str (WYB-entsel "\n选择材料标记: " '((0 . "TEXT"))))
    
60.   (WYB-CMD1)
    
61.   (if (not ACW-md) (setq ACW-md 7.85))
    
62.   (if (not ACW-txh) (setq ACW-txh 4 txh 4) (setq txh ACW-txh))
    
63.   (setq str (cdr (assoc 1 (entget (car str)))))
    
64.   (setq str (WYB-strreplace " " "" str));去空格
    
65.   (setq str (strcase str));全部大写
    
66.   (cond  ;所有关键词必须大写!
    
67.     (  (IfNum str (list "筒体DN" "%%130=" "H=") nil)
    
68.       (setq a (GetNum "筒体DN"))
    
69.       (setq b (GetNum "%%130="))
    
70.       (setq c (GetNum "H="))
    
71.       (Setup)
    
72.       (setq ans (* (+ (* a b 4.) (* b b 4.)) pi c md 0.00000025))
    
73.     )
    
74.     (  (IfNum str (list "椭圆形封头EHA" "X") nil)
    
75.       (setq a (GetNum "椭圆形封头EHA"))
    
76.       (setq b (GetNum "X"))
    
77.       (cond
    
78.         ((vl-string-search "H=" str) (setq c (GetNum "H=")))
    
79.         ((< a 2000) (setq c 25.))
    
80.         ((setq c 40.))
    
81.       )
    
82.       (Setup)
    
83.       (setq ans (* (+ (* a a (/ 1. 3.)) (* a b (/ 5. 6.)) (* b b (/ 2. 3.)) (* (+ a b) c)) b md pi 0.000001))
    
84.     )
    
85.     (  (or (IfNum str (list "管%%C" "X") nil)
    
86.         (IfNum str (list "筒%%C" "X") nil)
    
87.         (IfNum str (list "节%%C" "X") nil)
    
88.       )
    
89.       (setq a (GetNum "%%C"))
    
90.       (setq b (GetNum "X"))
    
91.       (cond
    
92.         ((vl-string-search "L=" str) (setq c (GetNum "L=")))
    
93.         ((vl-string-search "L≈" str) (setq c (GetNum "L≈")))
    
94.         ((setq c (WYB-getreal "\n管长: <110> " 110.)))
    
95.       )
    
96.       (Setup)
    
97.       (setq ans (* (- (* a b 4.) (* b b 4.)) pi c md 0.00000025))
    
98.     )
    
99.     (  (IfNum str (list "板-" "X") nil)
    
100.       (setq a (GetNum "板-"))
     
101.       (setq b (GetNum "X"))
     
102.       (cond
     
103.         ((vl-string-search "L=" str) (setq c (GetNum "L=")))
     
104.         ((vl-string-search "L≈" str) (setq c (GetNum "L≈")))
     
105.         ((setq c (WYB-getreal "\n第三边长度: <100> " 100.)))
     
106.       )
     
107.       (Setup)
     
108.       (setq ans (* a b c md 0.000001))
     
109.     )
     
110.     (  (IfNum str (list "板" "X") nil)
     
111.       (setq a (GetNum "板"))
     
112.       (setq b (GetNum "X"))
     
113.       (cond
     
114.         ((IfNum str (list "%%130=") nil) (setq c (GetNum "%%130=")))
     
115.         ((IfNum str (list "X") nil) (setq c (GetNum "X")))
     
116.         ((setq c (WYB-getreal "\n第三边长度: <10> " 10.)))
     
117.       )
     
118.       (Setup)
     
119.       (setq ans (* a b c md 0.000001))
     
120.     )
     
121.     (  (IfNum str (list "块" "X") nil)
     
122.       (setq a (GetNum "块"))
     
123.       (setq b (GetNum "X"))
     
124.       (cond
     
125.         ((IfNum str (list "%%130=") nil) (setq c (GetNum "%%130=")))
     
126.         ((IfNum str (list "X") nil) (setq c (GetNum "X")))
     
127.         ((setq c (WYB-getreal "\n第三边长度: <10> " 10.)))
     
128.       )
     
129.       (Setup)
     
130.       (setq ans (* a b c md 0.000001))
     
131.     )
     
132.     (  (IfNum str (list "板" "%%C" "%%130=") (list "/%%C"))
     
133.       (setq a (GetNum "%%C"))
     
134.       (setq b (GetNum "%%130="))
     
135.       (Setup)
     
136.       (setq ans (* a a b pi md 0.00000025))
     
137.     )
     
138.     (  (or (IfNum str (list "圈" "%%C" "/%%C" "%%130=") nil)
     
139.         (IfNum str (list "环" "%%C" "/%%C" "%%130=") nil)
     
140.       )
     
141.       (setq a (GetNum "%%C"))
     
142.       (setq b (GetNum "/%%C"))
     
143.       (setq c (GetNum "%%130="))
     
144.       (Setup)
     
145.       (setq ans (* (- (* a a) (* b b)) c pi md 0.00000025))
     
146.     )
     
147.     (  (IfNum str (list "角钢" "X") nil)
     
148.       (cond
     
149.         ((vl-string-search "角钢∠" str) (setq a (GetNum "角钢∠")))
     
150.         ((vl-string-search "角钢" str) (setq a (GetNum "角钢")))
     
151.         ((vl-string-search "角钢法兰" str) (setq a (GetNum "角钢法兰")))
     
152.       )
     
153.       (setq b (GetNum "X"))
     
154.       (if (vl-string-search "X" str) (setq c (GetNum "X")) (setq c b b a))
     
155.       (cond
     
156.         ((vl-string-search "L=" str) (setq d (GetNum "L=")))
     
157.         ((vl-string-search "L≈" str) (setq d (GetNum "L≈")))
     
158.         ((setq d (WYB-getreal "\n长度: <1000> " 1000.)))
     
159.       )
     
160.       (Setup)
     
161.       (setq ans (* (- (+ a b) c) c d md 0.000001))
     
162.     )
     
163.   )
     
164.   (if ans
     
165.     (progn (WYB-ExportAns ans txh) (princ "\n完成计算!"))
     
166.     (princ "\n该材料标记格式未添加至本程序!")
     
167.   )
     
168.   (princ)
     
169. )

;;CalWt自动计算标准格式的材料质量<br /> ;;by woyb<br /> (defun c:CalWt( / Setup IfNum GetNum txh str md nlst a b c ans)<br />   ;根据关键词判断数据是否齐全<br />   (defun IfNum (str lst1 lst2 / str1 i key n)<br />     (setq n (length lst1))<br />     (setq i 0 key t)<br />     (while (and key (< i n))<br />       (setq str1 (nth i lst1))<br />       (if (vl-string-search str1 str)<br />         (progn<br />           (setq i (1+ i))<br />           (setq str (substr str (+ (vl-string-search str1 str) (1+ (strlen str1)))))<br />         )<br />         (setq key nil)<br />       )<br />     )<br />     (if lst2<br />       (progn<br />         (setq n (length lst2))<br />         (setq i 0)<br />         (while (and key (< i n))<br />           (setq str1 (nth i lst2))<br />           (if (vl-string-search str1 str)<br />             (setq key nil)<br />             (setq i (1+ i))<br />           )<br />         )<br />       )<br />     )<br />     key<br />   )<br />   ;提取关键词后的字符，并转化数字<br />   (defun GetNum (str1 / n a)<br />     (setq n (1+ (strlen str1)))<br />     (setq str (substr str (+ (vl-string-search str1 str) n)))<br />     (setq a (atof str))<br />   )<br />   ;取值函数<br />   (defun Setup()<br />     (initget "s d f")<br />     (setq md (getreal (strcat "\n密度g/cm3 或 设置字高[S] 7.85[D] 7.98[F]: <" (rtos ACW-md)">")))<br />     (cond<br />       ((= md "s") <br />         (setq txh (getreal (strcat "\n写入重量的文字高度: <"(rtos ACW-txh)"> ")))<br />         (if txh (setq ACW-txh txh) (setq txh ACW-txh))<br />         (Setup)<br />       )<br />       ((= md "d") (setq md 7.85) (setq ACW-md 7.85))<br />       ((= md "f") (setq md 7.98) (setq ACW-md 7.98))<br />       (md (setq ACW-md md))<br />       ((setq md ACW-md))<br />     )<br />   )<br />   (if (not cal) (princ "\ncal..."))<br />   (princ "\n计算标准标记格式的材料重量: ")<br />   (WYB-CMD0)<br />   (setq str (WYB-entsel "\n选择材料标记: " '((0 . "TEXT"))))<br />   (WYB-CMD1)<br />   (if (not ACW-md) (setq ACW-md 7.85))<br />   (if (not ACW-txh) (setq ACW-txh 4 txh 4) (setq txh ACW-txh))<br />   (setq str (cdr (assoc 1 (entget (car str)))))<br />   (setq str (WYB-strreplace " " "" str));去空格<br />   (setq str (strcase str));全部大写<br />   (cond  ;所有关键词必须大写!<br />     (  (IfNum str (list "筒体DN" "%%130=" "H=") nil)<br />       (setq a (GetNum "筒体DN"))<br />       (setq b (GetNum "%%130="))<br />       (setq c (GetNum "H="))<br />       (Setup)<br />       (setq ans (* (+ (* a b 4.) (* b b 4.)) pi c md 0.00000025))<br />     )<br />     (  (IfNum str (list "椭圆形封头EHA" "X") nil)<br />       (setq a (GetNum "椭圆形封头EHA"))<br />       (setq b (GetNum "X"))<br />       (cond<br />         ((vl-string-search "H=" str) (setq c (GetNum "H=")))<br />         ((< a 2000) (setq c 25.))<br />         ((setq c 40.))<br />       )<br />       (Setup)<br />       (setq ans (* (+ (* a a (/ 1. 3.)) (* a b (/ 5. 6.)) (* b b (/ 2. 3.)) (* (+ a b) c)) b md pi 0.000001))<br />     )<br />     (  (or (IfNum str (list "管%%C" "X") nil) <br />         (IfNum str (list "筒%%C" "X") nil)<br />         (IfNum str (list "节%%C" "X") nil)<br />       )<br />       (setq a (GetNum "%%C"))<br />       (setq b (GetNum "X"))<br />       (cond<br />         ((vl-string-search "L=" str) (setq c (GetNum "L=")))<br />         ((vl-string-search "L≈" str) (setq c (GetNum "L≈")))<br />         ((setq c (WYB-getreal "\n管长: <110> " 110.)))<br />       )<br />       (Setup)<br />       (setq ans (* (- (* a b 4.) (* b b 4.)) pi c md 0.00000025))<br />     )<br />     (  (IfNum str (list "板-" "X") nil)<br />       (setq a (GetNum "板-"))<br />       (setq b (GetNum "X"))<br />       (cond<br />         ((vl-string-search "L=" str) (setq c (GetNum "L=")))<br />         ((vl-string-search "L≈" str) (setq c (GetNum "L≈")))<br />         ((setq c (WYB-getreal "\n第三边长度: <100> " 100.)))<br />       )<br />       (Setup)<br />       (setq ans (* a b c md 0.000001))<br />     )<br />     (  (IfNum str (list "板" "X") nil)<br />       (setq a (GetNum "板"))<br />       (setq b (GetNum "X"))<br />       (cond<br />         ((IfNum str (list "%%130=") nil) (setq c (GetNum "%%130=")))<br />         ((IfNum str (list "X") nil) (setq c (GetNum "X")))<br />         ((setq c (WYB-getreal "\n第三边长度: <10> " 10.)))<br />       )<br />       (Setup)<br />       (setq ans (* a b c md 0.000001))<br />     )<br />     (  (IfNum str (list "块" "X") nil)<br />       (setq a (GetNum "块"))<br />       (setq b (GetNum "X"))<br />       (cond<br />         ((IfNum str (list "%%130=") nil) (setq c (GetNum "%%130=")))<br />         ((IfNum str (list "X") nil) (setq c (GetNum "X")))<br />         ((setq c (WYB-getreal "\n第三边长度: <10> " 10.)))<br />       )<br />       (Setup)<br />       (setq ans (* a b c md 0.000001))<br />     )<br />     (  (IfNum str (list "板" "%%C" "%%130=") (list "/%%C"))<br />       (setq a (GetNum "%%C"))<br />       (setq b (GetNum "%%130="))<br />       (Setup)<br />       (setq ans (* a a b pi md 0.00000025))<br />     )<br />     (  (or (IfNum str (list "圈" "%%C" "/%%C" "%%130=") nil)<br />         (IfNum str (list "环" "%%C" "/%%C" "%%130=") nil)<br />       )<br />       (setq a (GetNum "%%C"))<br />       (setq b (GetNum "/%%C"))<br />       (setq c (GetNum "%%130="))<br />       (Setup)<br />       (setq ans (* (- (* a a) (* b b)) c pi md 0.00000025))<br />     )<br />     (  (IfNum str (list "角钢" "X") nil)<br />       (cond<br />         ((vl-string-search "角钢∠" str) (setq a (GetNum "角钢∠")))<br />         ((vl-string-search "角钢" str) (setq a (GetNum "角钢")))<br />         ((vl-string-search "角钢法兰" str) (setq a (GetNum "角钢法兰")))<br />       )<br />       (setq b (GetNum "X"))<br />       (if (vl-string-search "X" str) (setq c (GetNum "X")) (setq c b b a))<br />       (cond<br />         ((vl-string-search "L=" str) (setq d (GetNum "L=")))<br />         ((vl-string-search "L≈" str) (setq d (GetNum "L≈")))<br />         ((setq d (WYB-getreal "\n长度: <1000> " 1000.)))<br />       )<br />       (Setup)<br />       (setq ans (* (- (+ a b) c) c d md 0.000001))<br />     )<br />   )<br />   (if ans <br />     (progn (WYB-ExportAns ans txh) (princ "\n完成计算!"))<br />     (princ "\n该材料标记格式未添加至本程序!")<br />   )<br />   (princ)<br /> )

lostbalance

新鲜8 发表于 2017-10-10 09:45
可以计算槽钢H钢工子钢吗

如果是名称标识中能表示出横截面的长宽厚尺寸的话，在规则中增加相应的计算公式后也是用的。不过，就我个人接触的经验来说，槽钢工字钢类的，如果是标准截面的，都使用的是标准代号。建一个代号和长度质量对应的数据库，也是可行的。

lostbalance

kexiya123 发表于 2016-9-24 15:49
可是我运行后，calwt error:CAO ZUO ERROE，please try a time。
没反应，咋回事？

我这边试了没什么问题啊。这个提示是怎么出现的？你是不是在旧版的基础上改的？新旧差代码还是有区别的

lostbalance

hao3ren 发表于 2016-9-25 19:19
命令: CalWt
参数类型错误: VLA-OBJECT nil

又检查了下，好像有几个函数漏了。第一次测试的时候，函数库好像没有清掉，以为齐了。
你再试下看看。

尘缘一生

希望大家编写一个门式钢架里面一块钢板变化尺寸后，直接出重量的程序！

gys2010

能不能搞一个自动的材料表

lostbalance

主题编辑不会顶贴的吗，自己顶一下吧，应该不算挖坟吧

kexiya123

lostbalance 发表于 2016-9-23 22:27
主题编辑不会顶贴的吗，自己顶一下吧，应该不算挖坟吧

可是我运行后，calwt error:CAO ZUO ERROE，please try a time。
没反应，咋回事？

kexiya123

lostbalance 发表于 2016-9-23 22:27
主题编辑不会顶贴的吗，自己顶一下吧，应该不算挖坟吧

可是我运行后，calwt error:CAO ZUO ERROE，please try a time。
没反应，咋回事？

hao3ren

命令: CalWt
参数类型错误: VLA-OBJECT nil

lostbalance

kexiya123 发表于 2016-9-24 15:49
可是我运行后，calwt error:CAO ZUO ERROE，please try a time。
没反应，咋回事？

你再试试看。重置了cad，又检查了下，这回应该可以了。