[LISP函数]：修改过的风管绘制程序

xiaping

我用了一下,总的感觉不错.但是四通的绘制好像还是有问题.无法得到理想的四通图形.还有带进一步改进.谢谢您提供源代码。有机会我们进一步交流一下。

libo2000

最初由 xiaping 发布
[B]我用了一下,总的感觉不错.但是四通的绘制好像还是有问题.无法得到理想的四通图形.还有带进一步改进.谢谢您提供源代码。有机会我们进一步交流一下。 [/B]

hehe,四通不好画的，有什么好的想法post

2. 
   
3.   [FONT=courier new]
   
4. ;********************************三通管绘制程序Begin*******************************
   
5. (defun c:cheng_fg_st04 ( / ln0 ln1 ln2 ln3 ln5 ln6 ln7 ln8  p0 p1 p2 p3 p4 p5 p6 p7
   
6.                                         p01 p02 p0 p11 p12 p21 p22 p31 p32 p51 p61 p71 p81
   
7.                                         angr fc1 fc2 len1 len2 w w1 w2 i ss hlfg)
   
8. 
   
9.   (chengs_getvar)
   
10.   (setq ss (ssadd))
    
11.   (setq ln0 (chengs_fglast ))  
    
12.   (setq ln1 (ssname ln0 1));风管中心线
    
13.   (setq ln2 (ssname ln0 2));风管管线
    
14.   (setq ln3 (ssname ln0 3));风管管线
    
15.   (setq ln0 (ssname ln0 0)) ;风管终线
    
16.   (ssadd ln2 ss)
    
17.   (ssadd ln3 ss)
    
18. 
    
19.   (if (and ln2 ln3)
    
20.     (progn
    
21.       (initget "F H")
    
22.       (setq hlfg (getkword "\n合流三通(H)/分流三通<F>： "))
    
23.       (if (and (/= hlfg "h") (/= hlfg "H"))
    
24.         (progn
    
25.           (while (= nil w1)
    
26.             (setq w1 (getint "\n左支管管径<300>： "))
    
27.             (if (= w1 nil) (setq w1 300))
    
28.                 (if (<= w1 0) (setq w1 nil))
    
29.           )
    
30.           (while (= nil w2)
    
31.             (princ "\n右支管管径<")(princ w1)(princ ">： ")
    
32.                 (setq w2 (getint))
    
33.                 (if (= w2 nil) (setq w2 w1))
    
34.                 (if (<= w2 0) (setq w2 nil) )
    
35.           )
    
36.         )
    
37.         (progn
    
38.           (while (= nil w1)
    
39.             (setq w1 (getint "\n合流管管径<300>： "))
    
40.             (if (= w1 nil) (setq w1 300))
    
41.                 (if (<= w1 0) (setq w1 nil))
    
42.             (setq w2 w1 hlfg "H")
    
43.           )
    
44.         )
    
45.       );endif w1
    
46.     );endprogn
    
47.     (setq ln1 nil)
    
48.   );endif ln2 ln3
    
49. 
    
50.   (command ".undo" "be")
    
51.   (setvar "osmode" 16567)
    
52.   (setq
    
53.           p01 (cdr (assoc 10 (entget ln0)))
    
54.           p02 (cdr (assoc 11 (entget ln0)))
    
55.           p0 (chengs_getpoint_mid p01 p02) ;风管终线的中点
    
56.           p11 (cdr (assoc 10 (entget ln1)))
    
57.           p12 (cdr (assoc 11 (entget ln1)))
    
58.           p21 (cdr (assoc 10 (entget ln2)))
    
59.           p22 (cdr (assoc 11 (entget ln2)))
    
60.           p31 (cdr (assoc 10 (entget ln3)))
    
61.           p32 (cdr (assoc 11 (entget ln3)))          
    
62.   )
    
63.   (if (= p22 nil)
    
64.     (setq
    
65.             p22 (chengs_assoc 10 ln2 2)
    
66.             p32 (chengs_assoc 10 ln3 2)
    
67.     )
    
68.   )
    
69.   (if (equal p11 p0)          ;风管角度
    
70.     (setq angr (angle p12 p0))
    
71.     (setq angr (angle p11 p0))
    
72.   )
    
73.   (setq w (distance (chengs_getpoint_per p0 p21 p22) (chengs_getpoint_per p0 p31 p32))) ;ln3->ln2距离,管径
    
74. 
    
75.   ;内圆弧长
    
76.   (setq
    
77.          fc1 (- (* w 0.75) (* 0.5 w1))
    
78.          fc2 (- (* w 0.75) (* 0.5 w2))
    
79.   )
    
80.   ;(if (> fc1 fc2) (setq fc1 fc2))
    
81. 
    
82.   ;支风管长
    
83.   (setq
    
84.          len1 (+ (* 1.25 w) (* 0.5 w1))
    
85.          len2 (+ (* 1.25 w) (* 0.5 w2))
    
86.   )
    
87.   (setq  
    
88.          p1 (polar p0 angr (* 0.75 w)) ;支风管中心线起点
    
89.          p2 (polar p1 (+ angr (/ pi 2)) (- (* w 2) (* 0.5 w1)));支风管1终点
    
90.          p3 (polar p1 (+ angr (/ pi 2) pi) (- (* w 2) (* 0.5 w2)));支风管2终点         
    
91.          p51 (polar p1 (+ angr (/ pi 2)) (- (* w 1.25) (* 0.5 w1))) ;支风管1起点
    
92.          p71 (polar p1 (+ angr (/ pi 2) pi) (- (* w 1.25) (* 0.5 w2))) ;支风管2起点
    
93.   )
    
94. 
    
95.   (setq ln6 (chengs_mline p51 p2 w1));支风管1
    
96.   (setq ln5 (car ln6) ln6 (cadr ln6))
    
97.   (ssadd ln5 ss)
    
98.   (ssadd ln6 ss)
    
99.   (setq ln8 (chengs_mline p71 p3 w2)) ;支风管2
    
100.   (setq ln7 (car ln8) ln8 (cadr ln8))
     
101.   (ssadd ln7 ss)
     
102.   (ssadd ln8 ss)
     
103. 
     
104.   (if (not cheng_fg_zxx)
     
105.     (setq cheng_fgzxx "cheng_fgs_mid"
     
106.             cheng_fg "cheng_fgs"
     
107.             cheng_fg_end "cheng_fgsend"
     
108.             cheng_fg_color "4"
     
109.     )
     
110.   )
     
111. 
     
112.   (setq p4 (cdr (assoc 11 (entget ln5)))
     
113.            p5 (cdr (assoc 11 (entget ln6)))
     
114.            p6 (cdr (assoc 11 (entget ln7)))
     
115.            p7 (cdr (assoc 11 (entget ln8)))
     
116.   )
     
117. 
     
118.   ;风管终线
     
119.   (setvar "cecolor" "2")
     
120.   (setvar "clayer" cheng_fg_end)
     
121.   (command ".line" p4 p5 "")
     
122.   (command ".line" p6 p7 "")
     
123. 
     
124.   (setvar "clayer" cheng_fg_zxx)
     
125.   (setvar "cecolor" "bylayer")
     
126.   (command ".line" p2 p3 "")  ;支风管中心线
     
127. 
     
128.   (command ".FILLET" "r" fc1)
     
129.   (command ".FILLET" ln2 ln5) ;支风管1内弯头
     
130.   (ssadd (entlast) ss)
     
131.   (command ".FILLET" "r" fc2)
     
132.   (command ".FILLET" ln3 ln8) ;支风管2内弯头
     
133.   (ssadd (entlast) ss)
     
134. 
     
135.   ;风管法兰
     
136.   (setvar "clayer" cheng_fg)
     
137.   (setvar "cecolor" "2")
     
138.   (setq p51 (polar p51 angr (/ w1 -2))
     
139.            p61 (chengs_getpoint_per3 p51 ln6)
     
140.            p71 (polar p71 angr (/ w2 -2))
     
141.            p81 (chengs_getpoint_per3 p71 ln7)
     
142.   )
     
143.   (command ".line" p51  p61 "")
     
144.   (command ".line" p71  p81 "")
     
145. 
     
146.   ;支风管外弯头
     
147.   (setvar "cecolor" cheng_fg_color)
     
148.   (if (/= hlfg "H")
     
149.     (command ".arc" p1 (polar p61 (angle p1 p2) -1) p61 )
     
150.     (command ".line" p61 p81 "")
     
151.   )
     
152.   (ssadd (entlast) ss)
     
153.   (if (/= hlfg "H")
     
154.     (progn
     
155.       (command ".arc" p1 (polar p81 (angle p1 p3) -1) p81 )
     
156.       (ssadd (entlast) ss)
     
157.     )
     
158.   )
     
159.   ;延长中心线
     
160.   (if (and (equal p0 p11) (/= hlfg "H"))
     
161.     (command ".EXTEND" (entlast) "" p11 "")
     
162.     (command ".EXTEND" (entlast) "" p12 "")
     
163.   )
     
164.   ;主风管加粗
     
165.   (if cheng_fglast_jc
     
166.     (progn
     
167.       (setq i 0)      
     
168.       (while (setq ln2 (ssname ss i))
     
169.         (setq i (+ i 1))
     
170.         (command ".pedit" ln2 "y" "w" cheng_fglast_jc "")
     
171.       );endwhile
     
172.     )
     
173.   );endif
     
174.   (setq cheng_fglast_jc nil)
     
175. 
     
176.   ;改变风管终线ln0图层
     
177.   (chengs_change ln0 8 cheng_fg)
     
178. 
     
179.   (command ".REDRAW")
     
180.   (command ".undo" "e")
     
181.   (chengs_setvar)  
     
182.   (princ)
     
183. );endfun cheng_fg_st04
     
184. 
     
185. 
     
186. (defun c:cheng_fg_st05 ( / ln1 ln2 ln3 ln5 ln6  w w2 sc1 sc12 sc2 angr angr2 ss ss2 jc_w i p5_x p6_x p5_y p6_y
     
187.                                       p21 p22 p31 p32 p0 p1 p2 p3 p5 p6 p6_ p7 p8  p9 pln2_ln5 pln2_ln6 pln3_ln5 pln3_ln6)  
     
188. ;;;本程序还未完成，还有bug待改进。
     
189.   (chengs_getvar)  
     
190.   (setvar "osmode" 695)
     
191.   (while (= nil ln1)
     
192.     (setq p0 (getpoint "\n选择风管中心线 ： "))
     
193.     (chengs_exit p0)
     
194.     (setq ln1 (ssget p0))
     
195.     (if ln1 (setq ln1 (ssname ln1 0)));中心线
     
196.     (if ln1 (setq ln2 (chengs_fg_getfg ln1)) (setq ln1 nil))
     
197.     (if ln2 (setq ln3 (car ln2) ln2 (cadr ln2)))        ;主风管线ln2 ln3
     
198.     (if (and ln2 ln3)
     
199.       (progn
     
200.          (while (= nil angr2)
     
201.            (setq angr2 (getangle p0 "\n主风管与支风管的夹角<30>： "))
     
202.            (if (or (= angr2 nil) (= angr2 ""))
     
203.              (setq angr2 30)
     
204.              (setq angr2 (chengs_pi2r (abs (- angr2 (angle (cdr (assoc 10 (entget ln1)))(cdr (assoc 11 (entget ln1))))))))
     
205.            )
     
206.          )
     
207. 
     
208.         (while (= nil sc1)
     
209.           (setq sc1 (getint "\n上支管管径<300>： "))
     
210.           (if (= sc1 nil) (setq sc1 300))
     
211.           (if (<= sc1 0) (setq sc1 nil))
     
212.         )
     
213. 
     
214.         (while (= nil sc2)
     
215.           (princ "\n下支管管径<")(princ sc1)(princ ">： ")
     
216.           (setq sc2 (getint ))
     
217.           (if (= sc2 nil) (setq sc2 sc1))
     
218.           (if (<= sc2 0) (setq sc2 nil) )
     
219.         )
     
220.       );endprogn
     
221.       (setq ln1 nil)
     
222.     );endif
     
223.   )  ;endwhile
     
224. 
     
225.   (command ".REDRAW")
     
226.   (command ".undo" "be")
     
227. 
     
228.   ;主风管是否加粗
     
229.   (setq jc_w (cdr (assoc 40 (entget ln2))) ss2 (ssadd))
     
230.   (if jc_w
     
231.     (progn
     
232.       (command ".pedit" ln2 "w" 0 "")
     
233.       (command ".EXPLODE" ln2)
     
234.       (setq ln2 (entlast))
     
235.       (ssadd ln2 ss2)
     
236.       (command ".pedit" ln3 "w" 0 "")
     
237.       (command ".EXPLODE" ln3)
     
238.       (setq ln3 (entlast))
     
239.       (ssadd ln3 ss2)
     
240.     )
     
241.   )
     
242.   (setvar "osmode" 16567)
     
243.   (setq
     
244.           p21 (cdr (assoc 10 (entget ln2)))
     
245.           p22 (cdr (assoc 11 (entget ln2)))
     
246.           p31 (cdr (assoc 10 (entget ln3)))
     
247.           p32 (cdr (assoc 11 (entget ln3)))
     
248.   )
     
249.   (if (= p22 nil)
     
250.     (setq
     
251.             p22 (chengs_assoc 10 ln2 2)
     
252.             p32 (chengs_assoc 10 ln3 2)
     
253.     )
     
254.   ) ;endif p22
     
255.   (setq w (distance (chengs_getpoint_per p0 p21 p22) (chengs_getpoint_per p0 p31 p32))) ;ln3->ln2距离
     
256.   (setq angr nil ss (ssadd))
     
257. (repeat 2
     
258.   (if angr
     
259.     (setq angr2 (* (- angr2 angr)-1))
     
260.     (setq angr2 (chengs_r2pi angr2))   
     
261.   )
     
262.   (setq
     
263.          angr (angle p21 p22)
     
264.          sc12 (/ sc1 2)
     
265.          w2 (/ w 2)
     
266.           angr2 (+ angr2 angr)
     
267.           p3 (polar p0 angr2 (+ w w sc1))
     
268.           p1 (polar p0 angr2 w2)
     
269.   )
     
270.   (setvar "clayer" cheng_fg_zxx)
     
271.   (setvar "cecolor" "bylayer")
     
272.   (command ".line" p0 p3 "")        ;风管中心线
     
273.   (ssadd (entlast) ss)
     
274. 
     
275.   (setq ln5 (chengs_mline p0 p3 sc1))        ;画支风管
     
276.   (setq ln6 (car ln5) ln5 (cadr ln5))                ;风管管线
     
277.   (ssadd ln5 ss)
     
278.   (ssadd ln6 ss)
     
279.   (ssadd ln5 ss2)
     
280.   (ssadd ln6 ss2)
     
281.   (setq p8 (cdr (assoc 11 (entget ln5)))
     
282.            p9 (cdr (assoc 11 (entget ln6)))
     
283.            p6 (polar p8 angr2 -10)
     
284.            p7 (polar p9 angr2 -10)
     
285.            p5 (chengs_getpoint_per3 p0 ln2)
     
286.            p5_x (car p5)
     
287.            p6_x (car p6)
     
288.            p5_y (cadr p5)
     
289.            p6_y (cadr p6)
     
290.   )
     
291.   (if (or (> p5_x p6_x) (and (equal p5_x p6_x 0.000001) (> p5_y p6_y) ))
     
292.    (progn
     
293.     (setq sc1 p6 p6 p7 p7 sc1)
     
294.    )
     
295.   )
     
296.   (command ".FILLET" "r" 0)
     
297.   (if p6_
     
298.     (progn
     
299.       (command ".FILLET" p6 p5)(princ 1)
     
300.       (command ".FILLET" p7 p6_)
     
301.     )
     
302.     (progn
     
303.       (command ".FILLET" p7 p5)
     
304.     )
     
305.   )
     
306.   (ssadd (entlast) ss2)
     
307.   (setvar "clayer" cheng_fg_end)
     
308.   (setvar "cecolor" "2")
     
309.   (command ".line" p8 p9 "")        ;风管终线
     
310.   (ssadd (entlast) ss)
     
311.   (setq sc1 sc2
     
312.           sc2 ln2
     
313.           ln2 ln3
     
314.           ln3 sc2
     
315.           p6_ p6
     
316.   )
     
317. );endrepeat
     
318. 
     
319.   ;原风管加粗
     
320.   (if jc_w
     
321.     (progn
     
322.       (setq i 0)
     
323.       (while (setq ln2 (ssname ss2 i))
     
324.         (setq i (+ i 1))
     
325.         (command ".pedit" ln2 "y" "w" jc_w "")
     
326.       )
     
327.     )
     
328.   );endif jc_w
     
329. 
     
330.   (setq p0 (car (chengs_inters ln1 (ssname ss 0))))
     
331.   (command ".break" ln1 p0 p0);打断中心线
     
332.   (command ".REDRAW")
     
333.   (command ".undo" "e")
     
334.   (chengs_setvar)
     
335.   (princ)
     
336. );endfun cheng_fg_st05
     
337. 
     
338. ;********************************三通管绘制程序End*******************************
     
339. 
     
340. ;********************************插入风管管件Begin********************************
     
341. ;图块的比例必须为1：100，图块的插入点为其中心点
     
342. (defun c:cheng_fg_insert (/ e0 ln1 ln2 ln3 angr angr2 w w2 p0 p1 p2 p3 p4 p5 p6)
     
343. (chengs_getvar)  
     
344.   (setvar "osmode" 695)
     
345.   (while (= nil ln1)
     
346.     (setq p0 (getpoint "\n选择风管中心线 ： "))
     
347.     (chengs_exit p0)
     
348.     (setq ln1 (ssget p0))
     
349.     (if ln1 (setq ln1 (ssname ln1 0)));中心线
     
350.     (if ln1 (setq ln2 (chengs_fg_getfg ln1)) (setq ln1 nil))
     
351.     (if ln2 (setq ln3 (car ln2) ln2 (cadr ln2)))        ;主风管线ln2 ln3
     
352.     (if (and ln2 ln3)
     
353.       (princ)
     
354.       (setq ln1 nil)
     
355.     )
     
356.   );endwhile
     
357.   (initget "F H Z")
     
358.   (setq e0 (getkword "\n选择插入：防火阀(H)/风阀<F>/自定义管件(Z)： "))
     
359.   (if (or (= e0 nil) (= e0 "")) (setq e0 "F"))
     
360.   (setq e0 (strcase e0))
     
361.   (setq angr (angle (cdr (assoc 10 (entget ln1))) (cdr (assoc 11 (entget ln1)))));风管角度
     
362.   (setq w (distance (chengs_getpoint_per3 p0 ln2) (chengs_getpoint_per3 p0 ln3))) ;ln3->ln2距离
     
363.   (setq w2 (/ w 2))
     
364.   (if (/= e0 "Z")
     
365.     (progn
     
366.       (setq w (getint "\n管件沿气流方向长度<250>： "))
     
367.       (if (or (<= w 0) (= w nil)) (setq w 250))
     
368.       (setq w (/ w 2))
     
369.       (setq
     
370.           angr2 (+ angr (/ pi 2))          
     
371. 
     
372.           p1 (polar p0 angr (* w -1))
     
373.           p2 (polar p1 angr2 w2)
     
374.           p3 (polar p1 angr2 (* w2 -1))
     
375. 
     
376.           p4 (polar p0 angr w)
     
377.           p5 (polar p4 angr2 w2)
     
378.           p6 (polar p4 angr2 (* w2 -1))
     
379.       )
     
380.     )
     
381.   );endif
     
382. 
     
383.   (setvar "clayer" cheng_fg)
     
384.   (setvar "cecolor" "7")
     
385.   (cond
     
386.     ((= e0 "F")
     
387.       (progn
     
388.         (command ".line" p2 p3 p5 p6 p2 "")
     
389.       )
     
390.     )
     
391. 
     
392.     ((= e0 "H")
     
393.       (progn
     
394.         (command ".line" p2 p3 p5 p6 p2 "")
     
395.         (command ".CIRCLE" p0 50)
     
396.         (command ".BHATCH" "S" (entlast) "" "P" "SOLID" "")
     
397.       )
     
398.     )
     
399. 
     
400.     ((= e0 "Z")
     
401.       (progn
     
402.         (while (= block nil)
     
403.           (setq block (getstring "\n管件图块文件名称： "))  ;图块比例为1：100  w2:风管管径一半
     
404.           (if (= (wcmatch block "*\.dwg") nil)
     
405.             (setq block (strcat block ".dwg"))
     
406.             (progn
     
407.               (setq block nil)
     
408.               (princ "\n该图块并不存在")
     
409.             )
     
410.           )
     
411.         );endwhile
     
412.         
     
413.         (setq w (* w2 2)) ;沿风管垂直方向放大（Y轴）
     
414.         (princ "\n管件沿风管垂直方向长<")(princ w)(princ ">： ")
     
415.         (setq w2 (getdist p0))
     
416.         (if (or (<= w2 0) (= w2 nil)) (setq w2 w) (setq w2 (* w2 2)))
     
417.         (setq w w2)
     
418.         (princ "\n管件沿风管水平方向<同上:")(princ w)(princ ">： ")
     
419.         (setq w2 (getdist p0))
     
420.         (if (or (<= w2 0) (= w2 nil)) (setq w2 w)) ;沿风管水平方向放大（X轴）
     
421.         (setq w (/ w 100) w2 (/ w2 100))
     
422.         (command ".insert"  block p0 w2 w angr)
     
423.       )
     
424.     )
     
425.   );endcond
     
426. 
     
427.   (chengs_setvar)
     
428.   (princ)
     
429. );endfun cheng_fg_insert
     
430. 
     
431. 
     
432. ;********************************插入风管管件End*********************************
     
433. ;更新对象属性
     
434. (defun chengs_change ( ename assoc_num newdate / elist edate update )
     
435.   (if (listp ename)
     
436.     (setq elist (entget (car ename)))
     
437.     (setq elist (entget ename))   
     
438.   )
     
439.   (if (= nil (numberp assoc_num)) (exit))  
     
440.   (setq edate (assoc assoc_num elist))
     
441.   (setq update (cons assoc_num newdate))
     
442.   (setq elist (subst update edate elist))
     
443.   (entmod elist)
     
444.   ;(if (setq ename (car (reverse (cadddr ename)))) (entupd ename))
     
445.   (princ)
     
446. )
     
447.   [/FONT]
     

<br />   [FONT=courier new]<br /> ;********************************三通管绘制程序Begin*******************************<br /> (defun c:cheng_fg_st04 ( / ln0 ln1 ln2 ln3 ln5 ln6 ln7 ln8  p0 p1 p2 p3 p4 p5 p6 p7 <br />                                         p01 p02 p0 p11 p12 p21 p22 p31 p32 p51 p61 p71 p81 <br />                                         angr fc1 fc2 len1 len2 w w1 w2 i ss hlfg)<br /> <br />   (chengs_getvar)<br />   (setq ss (ssadd))<br />   (setq ln0 (chengs_fglast ))  <br />   (setq ln1 (ssname ln0 1));风管中心线<br />   (setq ln2 (ssname ln0 2));风管管线<br />   (setq ln3 (ssname ln0 3));风管管线<br />   (setq ln0 (ssname ln0 0)) ;风管终线<br />   (ssadd ln2 ss)<br />   (ssadd ln3 ss)<br /> <br />   (if (and ln2 ln3)<br />     (progn<br />       (initget "F H")<br />       (setq hlfg (getkword "\n合流三通(H)/分流三通<F>： "))<br />       (if (and (/= hlfg "h") (/= hlfg "H"))<br />         (progn<br />           (while (= nil w1)<br />             (setq w1 (getint "\n左支管管径<300>： "))<br />             (if (= w1 nil) (setq w1 300))<br />                 (if (<= w1 0) (setq w1 nil))<br />           )<br />           (while (= nil w2)<br />             (princ "\n右支管管径<")(princ w1)(princ ">： ")<br />                 (setq w2 (getint))<br />                 (if (= w2 nil) (setq w2 w1))<br />                 (if (<= w2 0) (setq w2 nil) )<br />           )<br />         )<br />         (progn<br />           (while (= nil w1)<br />             (setq w1 (getint "\n合流管管径<300>： "))<br />             (if (= w1 nil) (setq w1 300))<br />                 (if (<= w1 0) (setq w1 nil))<br />             (setq w2 w1 hlfg "H")<br />           )<br />         )<br />       );endif w1<br />     );endprogn<br />     (setq ln1 nil)<br />   );endif ln2 ln3<br /> <br />   (command ".undo" "be")<br />   (setvar "osmode" 16567)<br />   (setq<br />           p01 (cdr (assoc 10 (entget ln0)))<br />           p02 (cdr (assoc 11 (entget ln0)))<br />           p0 (chengs_getpoint_mid p01 p02) ;风管终线的中点<br />           p11 (cdr (assoc 10 (entget ln1)))<br />           p12 (cdr (assoc 11 (entget ln1)))<br />           p21 (cdr (assoc 10 (entget ln2)))<br />           p22 (cdr (assoc 11 (entget ln2)))<br />           p31 (cdr (assoc 10 (entget ln3)))<br />           p32 (cdr (assoc 11 (entget ln3)))          <br />   )<br />   (if (= p22 nil)<br />     (setq<br />             p22 (chengs_assoc 10 ln2 2)<br />             p32 (chengs_assoc 10 ln3 2)<br />     )<br />   )<br />   (if (equal p11 p0)          ;风管角度<br />     (setq angr (angle p12 p0))<br />     (setq angr (angle p11 p0))<br />   )<br />   (setq w (distance (chengs_getpoint_per p0 p21 p22) (chengs_getpoint_per p0 p31 p32))) ;ln3->ln2距离,管径<br /> <br />   ;内圆弧长<br />   (setq<br />          fc1 (- (* w 0.75) (* 0.5 w1))<br />          fc2 (- (* w 0.75) (* 0.5 w2))<br />   )<br />   ;(if (> fc1 fc2) (setq fc1 fc2))<br /> <br />   ;支风管长<br />   (setq <br />          len1 (+ (* 1.25 w) (* 0.5 w1))<br />          len2 (+ (* 1.25 w) (* 0.5 w2))<br />   )<br />   (setq  <br />          p1 (polar p0 angr (* 0.75 w)) ;支风管中心线起点<br />          p2 (polar p1 (+ angr (/ pi 2)) (- (* w 2) (* 0.5 w1)));支风管1终点<br />          p3 (polar p1 (+ angr (/ pi 2) pi) (- (* w 2) (* 0.5 w2)));支风管2终点         <br />          p51 (polar p1 (+ angr (/ pi 2)) (- (* w 1.25) (* 0.5 w1))) ;支风管1起点<br />          p71 (polar p1 (+ angr (/ pi 2) pi) (- (* w 1.25) (* 0.5 w2))) ;支风管2起点<br />   )<br /> <br />   (setq ln6 (chengs_mline p51 p2 w1));支风管1<br />   (setq ln5 (car ln6) ln6 (cadr ln6))<br />   (ssadd ln5 ss)<br />   (ssadd ln6 ss)<br />   (setq ln8 (chengs_mline p71 p3 w2)) ;支风管2<br />   (setq ln7 (car ln8) ln8 (cadr ln8))<br />   (ssadd ln7 ss)<br />   (ssadd ln8 ss)<br /> <br />   (if (not cheng_fg_zxx) <br />     (setq cheng_fgzxx "cheng_fgs_mid"<br />             cheng_fg "cheng_fgs"<br />             cheng_fg_end "cheng_fgsend"<br />             cheng_fg_color "4"<br />     )<br />   )<br /> <br />   (setq p4 (cdr (assoc 11 (entget ln5)))<br />            p5 (cdr (assoc 11 (entget ln6))) <br />            p6 (cdr (assoc 11 (entget ln7))) <br />            p7 (cdr (assoc 11 (entget ln8))) <br />   )<br /> <br />   ;风管终线<br />   (setvar "cecolor" "2")<br />   (setvar "clayer" cheng_fg_end)<br />   (command ".line" p4 p5 "")<br />   (command ".line" p6 p7 "")<br /> <br />   (setvar "clayer" cheng_fg_zxx) <br />   (setvar "cecolor" "bylayer")<br />   (command ".line" p2 p3 "")  ;支风管中心线<br /> <br />   (command ".FILLET" "r" fc1)<br />   (command ".FILLET" ln2 ln5) ;支风管1内弯头<br />   (ssadd (entlast) ss)<br />   (command ".FILLET" "r" fc2)<br />   (command ".FILLET" ln3 ln8) ;支风管2内弯头 <br />   (ssadd (entlast) ss)<br /> <br />   ;风管法兰<br />   (setvar "clayer" cheng_fg)<br />   (setvar "cecolor" "2")<br />   (setq p51 (polar p51 angr (/ w1 -2))<br />            p61 (chengs_getpoint_per3 p51 ln6)<br />            p71 (polar p71 angr (/ w2 -2))<br />            p81 (chengs_getpoint_per3 p71 ln7)<br />   )<br />   (command ".line" p51  p61 "") <br />   (command ".line" p71  p81 "") <br /> <br />   ;支风管外弯头<br />   (setvar "cecolor" cheng_fg_color)<br />   (if (/= hlfg "H") <br />     (command ".arc" p1 (polar p61 (angle p1 p2) -1) p61 )<br />     (command ".line" p61 p81 "")<br />   )<br />   (ssadd (entlast) ss)<br />   (if (/= hlfg "H") <br />     (progn<br />       (command ".arc" p1 (polar p81 (angle p1 p3) -1) p81 )<br />       (ssadd (entlast) ss)<br />     )<br />   )<br />   ;延长中心线<br />   (if (and (equal p0 p11) (/= hlfg "H"))<br />     (command ".EXTEND" (entlast) "" p11 "")<br />     (command ".EXTEND" (entlast) "" p12 "")<br />   )<br />   ;主风管加粗<br />   (if cheng_fglast_jc<br />     (progn<br />       (setq i 0)      <br />       (while (setq ln2 (ssname ss i))<br />         (setq i (+ i 1))<br />         (command ".pedit" ln2 "y" "w" cheng_fglast_jc "")<br />       );endwhile<br />     )<br />   );endif<br />   (setq cheng_fglast_jc nil)<br /> <br />   ;改变风管终线ln0图层<br />   (chengs_change ln0 8 cheng_fg)<br /> <br />   (command ".REDRAW")<br />   (command ".undo" "e")<br />   (chengs_setvar)  <br />   (princ)<br /> );endfun cheng_fg_st04<br /> <br /> <br /> (defun c:cheng_fg_st05 ( / ln1 ln2 ln3 ln5 ln6  w w2 sc1 sc12 sc2 angr angr2 ss ss2 jc_w i p5_x p6_x p5_y p6_y<br />                                       p21 p22 p31 p32 p0 p1 p2 p3 p5 p6 p6_ p7 p8  p9 pln2_ln5 pln2_ln6 pln3_ln5 pln3_ln6)  <br /> ;;;本程序还未完成，还有bug待改进。<br />   (chengs_getvar)  <br />   (setvar "osmode" 695)<br />   (while (= nil ln1)<br />     (setq p0 (getpoint "\n选择风管中心线 ： "))<br />     (chengs_exit p0)<br />     (setq ln1 (ssget p0))<br />     (if ln1 (setq ln1 (ssname ln1 0)));中心线<br />     (if ln1 (setq ln2 (chengs_fg_getfg ln1)) (setq ln1 nil))<br />     (if ln2 (setq ln3 (car ln2) ln2 (cadr ln2)))        ;主风管线ln2 ln3<br />     (if (and ln2 ln3)<br />       (progn<br />          (while (= nil angr2)<br />            (setq angr2 (getangle p0 "\n主风管与支风管的夹角<30>： "))<br />            (if (or (= angr2 nil) (= angr2 ""))<br />              (setq angr2 30)<br />              (setq angr2 (chengs_pi2r (abs (- angr2 (angle (cdr (assoc 10 (entget ln1)))(cdr (assoc 11 (entget ln1))))))))<br />            )<br />          )<br /> <br />         (while (= nil sc1)<br />           (setq sc1 (getint "\n上支管管径<300>： "))<br />           (if (= sc1 nil) (setq sc1 300))<br />           (if (<= sc1 0) (setq sc1 nil))<br />         )<br /> <br />         (while (= nil sc2)<br />           (princ "\n下支管管径<")(princ sc1)(princ ">： ")<br />           (setq sc2 (getint ))<br />           (if (= sc2 nil) (setq sc2 sc1))<br />           (if (<= sc2 0) (setq sc2 nil) )<br />         )<br />       );endprogn<br />       (setq ln1 nil)<br />     );endif<br />   )  ;endwhile<br /> <br />   (command ".REDRAW")<br />   (command ".undo" "be")<br /> <br />   ;主风管是否加粗<br />   (setq jc_w (cdr (assoc 40 (entget ln2))) ss2 (ssadd))<br />   (if jc_w <br />     (progn<br />       (command ".pedit" ln2 "w" 0 "")<br />       (command ".EXPLODE" ln2)<br />       (setq ln2 (entlast))<br />       (ssadd ln2 ss2)<br />       (command ".pedit" ln3 "w" 0 "")<br />       (command ".EXPLODE" ln3)<br />       (setq ln3 (entlast))<br />       (ssadd ln3 ss2)<br />     )<br />   )<br />   (setvar "osmode" 16567)<br />   (setq<br />           p21 (cdr (assoc 10 (entget ln2)))<br />           p22 (cdr (assoc 11 (entget ln2)))<br />           p31 (cdr (assoc 10 (entget ln3)))<br />           p32 (cdr (assoc 11 (entget ln3)))<br />   )<br />   (if (= p22 nil)<br />     (setq<br />             p22 (chengs_assoc 10 ln2 2)<br />             p32 (chengs_assoc 10 ln3 2)<br />     )<br />   ) ;endif p22<br />   (setq w (distance (chengs_getpoint_per p0 p21 p22) (chengs_getpoint_per p0 p31 p32))) ;ln3->ln2距离<br />   (setq angr nil ss (ssadd))<br /> (repeat 2<br />   (if angr<br />     (setq angr2 (* (- angr2 angr)-1))<br />     (setq angr2 (chengs_r2pi angr2))    <br />   )<br />   (setq<br />          angr (angle p21 p22)<br />          sc12 (/ sc1 2)<br />          w2 (/ w 2)<br />           angr2 (+ angr2 angr)<br />           p3 (polar p0 angr2 (+ w w sc1))<br />           p1 (polar p0 angr2 w2)<br />   )<br />   (setvar "clayer" cheng_fg_zxx)<br />   (setvar "cecolor" "bylayer")<br />   (command ".line" p0 p3 "")        ;风管中心线<br />   (ssadd (entlast) ss)<br /> <br />   (setq ln5 (chengs_mline p0 p3 sc1))        ;画支风管<br />   (setq ln6 (car ln5) ln5 (cadr ln5))                ;风管管线<br />   (ssadd ln5 ss)<br />   (ssadd ln6 ss)<br />   (ssadd ln5 ss2)<br />   (ssadd ln6 ss2)<br />   (setq p8 (cdr (assoc 11 (entget ln5)))<br />            p9 (cdr (assoc 11 (entget ln6)))<br />            p6 (polar p8 angr2 -10)<br />            p7 (polar p9 angr2 -10)<br />            p5 (chengs_getpoint_per3 p0 ln2)<br />            p5_x (car p5)<br />            p6_x (car p6)<br />            p5_y (cadr p5)<br />            p6_y (cadr p6)<br />   )<br />   (if (or (> p5_x p6_x) (and (equal p5_x p6_x 0.000001) (> p5_y p6_y) ))<br />    (progn<br />     (setq sc1 p6 p6 p7 p7 sc1)<br />    )<br />   )<br />   (command ".FILLET" "r" 0)<br />   (if p6_ <br />     (progn<br />       (command ".FILLET" p6 p5)(princ 1)<br />       (command ".FILLET" p7 p6_)<br />     )<br />     (progn<br />       (command ".FILLET" p7 p5)<br />     )<br />   )<br />   (ssadd (entlast) ss2)<br />   (setvar "clayer" cheng_fg_end)<br />   (setvar "cecolor" "2")<br />   (command ".line" p8 p9 "")        ;风管终线<br />   (ssadd (entlast) ss)<br />   (setq sc1 sc2<br />           sc2 ln2<br />           ln2 ln3<br />           ln3 sc2<br />           p6_ p6<br />   )<br /> );endrepeat <br /> <br />   ;原风管加粗<br />   (if jc_w<br />     (progn<br />       (setq i 0)<br />       (while (setq ln2 (ssname ss2 i))<br />         (setq i (+ i 1))<br />         (command ".pedit" ln2 "y" "w" jc_w "")<br />       ) <br />     ) <br />   );endif jc_w<br /> <br />   (setq p0 (car (chengs_inters ln1 (ssname ss 0))))<br />   (command ".break" ln1 p0 p0);打断中心线<br />   (command ".REDRAW")<br />   (command ".undo" "e")<br />   (chengs_setvar)<br />   (princ)<br /> );endfun cheng_fg_st05<br /> <br /> ;********************************三通管绘制程序End*******************************<br /> <br /> ;********************************插入风管管件Begin********************************<br /> ;图块的比例必须为1：100，图块的插入点为其中心点<br /> (defun c:cheng_fg_insert (/ e0 ln1 ln2 ln3 angr angr2 w w2 p0 p1 p2 p3 p4 p5 p6)<br /> (chengs_getvar)  <br />   (setvar "osmode" 695)<br />   (while (= nil ln1)<br />     (setq p0 (getpoint "\n选择风管中心线 ： "))<br />     (chengs_exit p0)<br />     (setq ln1 (ssget p0))<br />     (if ln1 (setq ln1 (ssname ln1 0)));中心线<br />     (if ln1 (setq ln2 (chengs_fg_getfg ln1)) (setq ln1 nil))<br />     (if ln2 (setq ln3 (car ln2) ln2 (cadr ln2)))        ;主风管线ln2 ln3<br />     (if (and ln2 ln3)<br />       (princ)<br />       (setq ln1 nil)<br />     )<br />   );endwhile<br />   (initget "F H Z")<br />   (setq e0 (getkword "\n选择插入：防火阀(H)/风阀<F>/自定义管件(Z)： "))<br />   (if (or (= e0 nil) (= e0 "")) (setq e0 "F"))<br />   (setq e0 (strcase e0))<br />   (setq angr (angle (cdr (assoc 10 (entget ln1))) (cdr (assoc 11 (entget ln1)))));风管角度<br />   (setq w (distance (chengs_getpoint_per3 p0 ln2) (chengs_getpoint_per3 p0 ln3))) ;ln3->ln2距离<br />   (setq w2 (/ w 2))<br />   (if (/= e0 "Z") <br />     (progn<br />       (setq w (getint "\n管件沿气流方向长度<250>： "))<br />       (if (or (<= w 0) (= w nil)) (setq w 250))<br />       (setq w (/ w 2))<br />       (setq <br />           angr2 (+ angr (/ pi 2))          <br /> <br />           p1 (polar p0 angr (* w -1))<br />           p2 (polar p1 angr2 w2)<br />           p3 (polar p1 angr2 (* w2 -1))<br /> <br />           p4 (polar p0 angr w)<br />           p5 (polar p4 angr2 w2)<br />           p6 (polar p4 angr2 (* w2 -1))<br />       )<br />     )<br />   );endif<br /> <br />   (setvar "clayer" cheng_fg)<br />   (setvar "cecolor" "7")<br />   (cond<br />     ((= e0 "F")<br />       (progn<br />         (command ".line" p2 p3 p5 p6 p2 "")<br />       )<br />     )<br /> <br />     ((= e0 "H")<br />       (progn<br />         (command ".line" p2 p3 p5 p6 p2 "")<br />         (command ".CIRCLE" p0 50)<br />         (command ".BHATCH" "S" (entlast) "" "P" "SOLID" "")<br />       )<br />     )<br /> <br />     ((= e0 "Z")<br />       (progn<br />         (while (= block nil)<br />           (setq block (getstring "\n管件图块文件名称： "))  ;图块比例为1：100  w2:风管管径一半<br />           (if (= (wcmatch block "*\.dwg") nil) <br />             (setq block (strcat block ".dwg")) <br />             (progn<br />               (setq block nil)<br />               (princ "\n该图块并不存在")<br />             )<br />           )<br />         );endwhile<br />         <br />         (setq w (* w2 2)) ;沿风管垂直方向放大（Y轴）<br />         (princ "\n管件沿风管垂直方向长<")(princ w)(princ ">： ")<br />         (setq w2 (getdist p0))<br />         (if (or (<= w2 0) (= w2 nil)) (setq w2 w) (setq w2 (* w2 2)))<br />         (setq w w2)<br />         (princ "\n管件沿风管水平方向<同上:")(princ w)(princ ">： ")<br />         (setq w2 (getdist p0))<br />         (if (or (<= w2 0) (= w2 nil)) (setq w2 w)) ;沿风管水平方向放大（X轴）<br />         (setq w (/ w 100) w2 (/ w2 100))<br />         (command ".insert"  block p0 w2 w angr)<br />       )<br />     )<br />   );endcond<br /> <br />   (chengs_setvar)<br />   (princ)<br /> );endfun cheng_fg_insert<br /> <br /> <br /> ;********************************插入风管管件End*********************************<br /> ;更新对象属性<br /> (defun chengs_change ( ename assoc_num newdate / elist edate update )<br />   (if (listp ename)<br />     (setq elist (entget (car ename)))<br />     (setq elist (entget ename))    <br />   )<br />   (if (= nil (numberp assoc_num)) (exit))  <br />   (setq edate (assoc assoc_num elist)) <br />   (setq update (cons assoc_num newdate)) <br />   (setq elist (subst update edate elist))<br />   (entmod elist)<br />   ;(if (setq ename (car (reverse (cadddr ename)))) (entupd ename))<br />   (princ)<br /> )<br />   [/FONT]<br />

lyg2911

各位仁兄，风管绘制的完成，但希望自动生成风管展开加工图，如何来实现

libo2000

图形DCL插入风管管件lisp.rar
－－配合cheng.lsp,chengs.lsp使用
展开图？？？
太太难了点！！

重新上传cheng.zip


***MENUGROUP=Cheng

***POP1
**Cheng
ID_CHENG       [&CHENG]
ID_CHENG_TH      [替换文本(&T)]^C^Ccheng_th
ID_CHENG_replace   [替换文字(&R)]^C^Ccheng_replace
ID_CHENG_find    [查找文字(&F)]^C^Ccheng_find
ID_CHENG_align   [文字对齐于线段(&A)]^C^Ccheng_align
ID_CHENG_txtfont   [修改字体(&N)]^C^Ccheng_txtfont
ID_CHENG_style   [修改大字体(&O)]^C^Ccheng_style
                 [--]
ID_CHENG_break   [从点打断(&B)]^C^Ccheng_break
ID_CHENG_zxx     [绘圆中心线(&Z)]^C^Ccheng_zxx
ID_CHENG_upline   [线段在上方(&U)]^C^Ccheng_upline
ID_CHENG_downline   [线段在下方(&D)]^C^Ccheng_downline
                 [--]
ID_CHENG_fg      [风管图层(&L)]^C^Ccheng_fglay
ID_CHENG_fg      [绘制风管(&G)]^C^Ccheng_fg
ID_CHENG_dxt     [风管大小头(&X)]^C^Ccheng_dxt
IF_CHENG_fgst      [->三通(&H)]
ID_CHENG_fg_st04   [插入三通(&S)]^C^Ccheng_fg_st04
ID_CHENG_fg_st05   [插入斜三通(&T)]^C^Ccheng_fg_st05
ID_CHENG_fgst2   [<-绘制三通(&H)]^C^Ccheng_fgst2
IF_CHENG_fgst      [->四通(&I)]
ID_CHENG_fgst2    [插入圆弧四通(&S)]^C^Ccheng_fg_st02
ID_CHENG_fgst1    [插入直角四通(&Z)]^C^Ccheng_fg_st01
ID_CHENG_fgst0    [插入圆角四通(&J)]^C^Ccheng_fg_st
ID_CHENG_fgst3    [<-插入斜四通(&X)]^C^Ccheng_fg_st03
IF_CHENG_CL      [->侧联风管(&C)]
ID_CHENG_clfg3     [侧联方风管(&C)]^C^Ccheng_clfg3
ID_CHENG_clfg      [侧联圆风管(&Y)]^C^Ccheng_clfg
ID_CHENG_clfg2     [<-侧联圆风管2(&L)]^C^Ccheng_clfg2
ID_CHENG_fgst3    [插入风管管件(&E)]^C^Ccheng_fg_insert
ID_CHENG_wt      [风管弯头(&W)]^C^Ccheng_wt
                 [--]

dwgplt

运行有错误呀，我把所有文件都复制到SUPPORT目录下，并设置好了风管图层。
可能是chengs.lsp中缺少chengs_getlineangle这个子程序吧。

Command: cheng_fg_insert

选择风管中心线： error: null function
(CHENGS_GETLINEANGLE LN1)
(SETQ ANGR (CHENGS_GETLINEANGLE LN1))
(C:CHENG_FG_INSERT)
*Cancel*

libo2000

最初由 dwgplt 发布
[B]运行有错误呀，我把所有文件都复制到SUPPORT目录下，并设置好了风管图层。
可能是chengs.lsp中缺少chengs_getlineangle这个子程序吧。

Command: cheng_fg_insert

选择风管中心线： error: null function
(CH... [/B]

重新上传了all file----在No.19 帖子的cheng。zip
昨天终于把由中心线得到风管程序cheng_fg_getfg完善。
如果想自己搞lisp的，这个函数比较有用－－当然风管图层设置必须正确，为适应天正风管图层，我将图层定义为：
1。风管：fg_lay
2。风管中心线：在风管图层后面加”_MID“
3。风管终线、始线：在风管图层后面加”END“
4。法兰：同风管，但是颜色为2－－无伤大雅。

这可能是最后一次上传cheng.lsp了，这段时候没事情干，研究研究autolisp，hehe，以后就难说了。
如果您有什么好的建议，请mailto:chenghell@tom.com

dwgplt

很好用，谢谢！

libo2000

最后一版

修改几个bug，补善几处地方。

弯头有问题，再改

关于因为CAD线型不能正常使用的问题：
  CAD线型问题，当时我没有考虑到cad中没有dote线型－－这个是天正的线型。
有2个修改方法：
1）、你可以找到acadr14\support\acad.lin（acad2000\support\acad.lin,其他CAD也是acad.lin）
并打开编辑，添加如下两行：
*DOTE,____ . ____ . ____ . ____ . ____ . ____ . ____ . ____
A,2.,-.2,.02,-.2
2）、你把cheng.lsp中的所有“dote”替换为“Dashdot”---不分大小写。“dashdot”是CAD的一个线型。
推荐使用方法1）

liangjiangx

这么多下载文件，究竟哪一个是全面最新的？
谢谢！

xiaping

最初由 liangjiangx 发布
[B]这么多下载文件，究竟哪一个是全面最新的？
谢谢！ [/B]

发布日期或编辑日期最后的就是最新的。

libo2000

2003-10-8
1、自定义了一个线型－－免得没有那个“dote”线型搞鬼；
2、增加sel命令；
3、文字镜像修复－－比天正的好用；
4、.......

uug

画风管程序很好用,很是提高效率,
建议图块按照新的制图标准多搞一些,要是能够自定义到图形对话框中就更好了

libo2000

不好意思，程序大包时候搞错，把老的没有改好弯头的cheng.lsp整进去了。

风管程序2003-10-9。hehe,这次弯头绘制应该不会再有问题了！

粗心是我的老毛病了，不过我会知错就改的.^_^



自定义风管管件的程序正在进行中。。。。。

iam0411

来晚了???

andyhua5240

晕，来晚了，什么也没有，只希望有更新的程序上传哦！