[求助]：怎样用CAD画三通管的展开图?

SLMin

*-*1 *-*1 *-*1
在AutoCAD中如何画一个三通的展开图?请大家指教!

cdhua001

变径三通展开：http://www.xdcad.net/forum/showt ... d=759999#post759999

SLMin

谢谢斑竹!不过这个链接的展开是一个圆锥体,并不是三通.在CAD中画变径三通的展开图看来不用VBA,或LISP好像很难啊!!!!

ahlzl

最初由 SLMin 发布
[B]*-*1 *-*1 *-*1
在AutoCAD中如何画一个三通的展开图?请大家指教! [/B]

你的三通是不是这样的？如不是，请传个图上来。

SLMin

是啊!这种是等经的,还有直径不同的.3D效果图可以画出来!就是展开图不知如何画?请指教啊!!

ahlzl

这种的吧,会有人来画的.主管和分支管应分别展开.

                               
登录/注册后可看大图

王建荣

！  其实这种扳金的展开图，在三维设计软年里面是非常容易就出来的。我式着用Inventor8做了一个，
！  Inventor是Autodesk公司专门针对机械设计而开发的三维软件，与Autocad完全兼容。画好后，可以转到CAD里面的。

就是这个三通。

王建荣

这是一个部分的零图，

王建荣

这是它的展开。

王建荣

这是它的第二个部分。

王建荣

这是它的展开，

SLMin

画的好啊!不过我要的是在CAD中画,最好把方法写出来啊!

柔柔

试试用投影法

ahlzl

我后来还是写了VBA程序.

2. 
   
3. Sub st_zg()
   
4. '画主管展开图
   
5. Dim R1, R2, L1 As Double
   
6. Dim pL, mipL, pL1, pL2 As AcadLWPolyline
   
7. Dim pt As Variant
   
8. Dim po(361) As Double
   
9. pi = 3.1415926535
   
10. 
    
11. pt = ThisDrawing.Utility.GetPoint(, "请输入变径管主管展开图的中心点：")
    
12. R1 = ThisDrawing.Utility.GetDistance(pt, "请输入变径管主管的半径：")
    
13. R2 = ThisDrawing.Utility.GetDistance(pt, "请输入变径管分支管的半径：")
    
14. L1 = ThisDrawing.Utility.GetDistance(pt, "请输入变径管主管的半长：")
    
15. 
    
16. If R2 > R1 Or R2 > L1 Then
    
17. MsgBox ("变径管分支管的半径不能大于主管的半径和半长！")
    
18. Exit Sub
    
19. End If
    
20. For a = 0 To 361 Step 2
    
21. po(a) = pt(0) - R2 + 2 * R2 * a / 360
    
22. x = Sin(a * pi / 360) * R2 / R1
    
23. po(a + 1) = pt(1) + R1 * (pi - Atn(x / Sqr(-x * x + 1)))
    
24. Next
    
25. 
    
26. Set pL = ThisDrawing.ModelSpace.AddLightWeightPolyline(po)
    
27. pt1 = ThisDrawing.Utility.PolarPoint(pt, 0, 10)
    
28. Set mipL = pL.Mirror(pt, pt1)
    
29. 
    
30. Dim ppt(7) As Double
    
31. ppt(0) = pt(0) + R2
    
32. ppt(1) = pt(1) + pi * R1
    
33. ppt(2) = pt(0) + L1
    
34. ppt(3) = ppt(1)
    
35. ppt(4) = ppt(2)
    
36. ppt(5) = pt(1) - pi * R1
    
37. ppt(6) = ppt(0)
    
38. ppt(7) = ppt(5)
    
39. Set pL1 = ThisDrawing.ModelSpace.AddLightWeightPolyline(ppt)
    
40. 
    
41. pt2 = ThisDrawing.Utility.PolarPoint(pt, 0.5 * pi, 10)
    
42. Set pL2 = pL1.Mirror(pt, pt2)
    
43. 
    
44. End Sub
    
45. 
    
46. Sub st_fzg()
    
47. '画分支管展开图
    
48. Dim R1, R2, L1 As Double
    
49. Dim pL, pL1 As AcadLWPolyline
    
50. Dim pt As Variant
    
51. Dim po(361) As Double
    
52. pi = 3.1415926535
    
53. 
    
54. pt = ThisDrawing.Utility.GetPoint(, "请输入三通分支管展开图的右下点：")
    
55. R1 = ThisDrawing.Utility.GetDistance(pt, "请输入三通主管的半径：")
    
56. R2 = ThisDrawing.Utility.GetDistance(pt, "请输入三通分支管的半径：")
    
57. L1 = ThisDrawing.Utility.GetDistance(pt, "请输入三通分支管的长度：")
    
58. 
    
59. If R2 > R1 Then
    
60. MsgBox ("变径管分支管的半径不能大于主管的半径！")
    
61. Exit Sub
    
62. End If
    
63. For a = 0 To 361 Step 2
    
64. po(a) = pt(0) + Sqr(R1 * R1 - (R2 * Sin(pi * (a + 90) / 180)) ^ 2) _
    
65. - L1 - R1
    
66. po(a + 1) = pt(1) + 2 * pi * R2 * a / 360
    
67. Next
    
68. Set pL = ThisDrawing.ModelSpace.AddLightWeightPolyline(po)
    
69. 
    
70. Dim ppt(7) As Double
    
71. ppt(0) = pt(0) - R1 + Sqr(R1 * R1 - R2 * R2) - L1
    
72. ppt(1) = pt(1)
    
73. ppt(2) = pt(0)
    
74. ppt(3) = pt(1)
    
75. ppt(4) = ppt(2)
    
76. ppt(5) = pt(1) + 2 * pi * R2
    
77. ppt(6) = ppt(0)
    
78. ppt(7) = ppt(5)
    
79. Set pL1 = ThisDrawing.ModelSpace.AddLightWeightPolyline(ppt)
    
80. 
    
81. End Sub
    

<br /> Sub st_zg()<br /> '画主管展开图<br /> Dim R1, R2, L1 As Double<br /> Dim pL, mipL, pL1, pL2 As AcadLWPolyline<br /> Dim pt As Variant<br /> Dim po(361) As Double<br /> pi = 3.1415926535<br /> <br /> pt = ThisDrawing.Utility.GetPoint(, "请输入变径管主管展开图的中心点：")<br /> R1 = ThisDrawing.Utility.GetDistance(pt, "请输入变径管主管的半径：")<br /> R2 = ThisDrawing.Utility.GetDistance(pt, "请输入变径管分支管的半径：")<br /> L1 = ThisDrawing.Utility.GetDistance(pt, "请输入变径管主管的半长：")<br /> <br /> If R2 > R1 Or R2 > L1 Then<br /> MsgBox ("变径管分支管的半径不能大于主管的半径和半长！")<br /> Exit Sub<br /> End If<br /> For a = 0 To 361 Step 2<br /> po(a) = pt(0) - R2 + 2 * R2 * a / 360<br /> x = Sin(a * pi / 360) * R2 / R1<br /> po(a + 1) = pt(1) + R1 * (pi - Atn(x / Sqr(-x * x + 1)))<br /> Next<br /> <br /> Set pL = ThisDrawing.ModelSpace.AddLightWeightPolyline(po)<br /> pt1 = ThisDrawing.Utility.PolarPoint(pt, 0, 10)<br /> Set mipL = pL.Mirror(pt, pt1)<br /> <br /> Dim ppt(7) As Double<br /> ppt(0) = pt(0) + R2<br /> ppt(1) = pt(1) + pi * R1<br /> ppt(2) = pt(0) + L1<br /> ppt(3) = ppt(1)<br /> ppt(4) = ppt(2)<br /> ppt(5) = pt(1) - pi * R1<br /> ppt(6) = ppt(0)<br /> ppt(7) = ppt(5)<br /> Set pL1 = ThisDrawing.ModelSpace.AddLightWeightPolyline(ppt)<br /> <br /> pt2 = ThisDrawing.Utility.PolarPoint(pt, 0.5 * pi, 10)<br /> Set pL2 = pL1.Mirror(pt, pt2)<br /> <br /> End Sub<br /> <br /> Sub st_fzg()<br /> '画分支管展开图<br /> Dim R1, R2, L1 As Double<br /> Dim pL, pL1 As AcadLWPolyline<br /> Dim pt As Variant<br /> Dim po(361) As Double<br /> pi = 3.1415926535<br /> <br /> pt = ThisDrawing.Utility.GetPoint(, "请输入三通分支管展开图的右下点：")<br /> R1 = ThisDrawing.Utility.GetDistance(pt, "请输入三通主管的半径：")<br /> R2 = ThisDrawing.Utility.GetDistance(pt, "请输入三通分支管的半径：")<br /> L1 = ThisDrawing.Utility.GetDistance(pt, "请输入三通分支管的长度：")<br /> <br /> If R2 > R1 Then<br /> MsgBox ("变径管分支管的半径不能大于主管的半径！")<br /> Exit Sub<br /> End If<br /> For a = 0 To 361 Step 2<br /> po(a) = pt(0) + Sqr(R1 * R1 - (R2 * Sin(pi * (a + 90) / 180)) ^ 2) _<br /> - L1 - R1<br /> po(a + 1) = pt(1) + 2 * pi * R2 * a / 360<br /> Next<br /> Set pL = ThisDrawing.ModelSpace.AddLightWeightPolyline(po)<br /> <br /> Dim ppt(7) As Double<br /> ppt(0) = pt(0) - R1 + Sqr(R1 * R1 - R2 * R2) - L1<br /> ppt(1) = pt(1)<br /> ppt(2) = pt(0)<br /> ppt(3) = pt(1)<br /> ppt(4) = ppt(2)<br /> ppt(5) = pt(1) + 2 * pi * R2<br /> ppt(6) = ppt(0)<br /> ppt(7) = ppt(5)<br /> Set pL1 = ThisDrawing.ModelSpace.AddLightWeightPolyline(ppt)<br /> <br /> End Sub<br />

附件是DVB文件.

ahlzl

这样运行.
我把程序分成了两段,如觉得这样不好,也可合二为一.
下载地址：http://www.xdcad.net/bbstech/acad/ahlzl/三通展开.swf

<embed src=http://www.xdcad.net/bbstech/acad/ahlzl/三通展开.swf  quality=high width=800 height=600 loop=true type="application/x-shockwave-flash">
</embed>