Auto CAD+Excel使用技巧与压力容器设计

兰州人

 通过本人对压力容器三维模型程序的研究，得出的结论是：AutoCAD+Excel技术是机械类设计工作者的必须掌握的基本工具，也是必须掌握生存手段之一。下图是本人采用Auto CAD+ Excel  作为绘图手段的作品之一。

 

兰州人

压力容器设计关键就是数据准备，采用交互式方法直接画图是目前通用的作法。几何形状相同尺寸有变化的压力容器零部件设计时，采用AutoCAD+Excel的手段参数化设计压力容器设计要比交互式AutoCAD设计，工作效率高，出图质量高是无庸质疑的结论。

1、AutoCAD

1.1 学习成本：AutoCad比其它制图软件应用要广泛的多，有广泛的群众基础，学习这个软件要比其它软件要方便的多，有老师教，同事之间可以相互交流，结论学习成本要比学其它软件低的多。

1.2 通用性：AutoCAD图形文件到全国各地任意工程单位都能打开，不需要转换，所谓比AutoCAD先进的软件（也不过是在某些特定行业，特定功能应用上），都必须要向AutoCAD靠拢，必须要有dwg输出格式。结论，dwg文件格式是当今通用的工程制图标准模式。

2、Excel

2.1 学习成本：在当今社会，不会Excel简直就不可能在这个行道有生存空间，设计就是天天和数据表格打交道。结论：数据表格处理，Excel是当今无论比学习成本最低的应用软件。

2.2 通用性，是台电脑就可以运行Excel，现在就连手机都可以用Excel.

结论：采用AutoCAD+Excel手段进行参数化设计，无论从学习成本和通用性角度出发，都是最优的选择。

兰州人

  
计算如图所示的换热器管板交点（换热管开孔），可用以下程序解决。程序自动读出线段，并计算出交点的坐标。

6. Sub Example_IntersectWith()
7.     Dim xlApp As Object    ' This Line ,Not set Excel , run Excel
8.     'Dim xlsheet As Object
9.    
10.     ' 发生错误时跳到下一个语句继续执行
11.     On Error Resume Next
12.     ' 连接Excel应用程序
13.     Set xlApp = GetObject(, "Excel.Application")
14.    
15.     If Err.Number <> 0 Then
16.         Set xlApp = CreateObject("Excel.Application")
17.         xlApp.Visible = True
18.         xlApp.Workbooks.Add
19.     End If
20.     ' 返回当前活动的工作表
21.     'Set xlsheet = xlApp.ActiveSheet
22.     Set xlSheet = xlApp.sheets(1)
23.     ' This example creates a line and circle and finds the points at
24.     ' which they intersect.
25.     Dim oBject As AcadEntity, oBject1 As AcadEntity
26.     Dim ii As Integer, jj As Integer
27.     Dim Ppt As Variant
28.     nn = 1
29.     For ii = 0 To ThisDrawing.ModelSpace.Count - 1
30.       
31.       Set oBject = ThisDrawing.ModelSpace.Item(ii)
32.       
33.       For jj = 0 To ThisDrawing.ModelSpace.Count - 1
34.         Set oBject1 = ThisDrawing.ModelSpace.Item(jj)
35.       
36.         Ppt = oBject1.IntersectWith(oBject, acExtendOtherEntity)
37.         xlSheet.Cells(nn, 1).Value = Format(Ppt(0), "0.0")
38.         xlSheet.Cells(nn, 2).Value = Format(Ppt(1), "0.0")
39.         xlSheet.Cells(nn, 3).Value = Ppt(2)
40.         Debug.Print Ppt(0), Ppt(1), Ppt(2)
41.         Debug.Print nn, oBject.Handle, oBject1.Handle
42.         xlSheet.Cells(nn, 4).Value = nn
43.         nn = nn + 1
44.       Next jj
45.     Next ii
46.    
47. End Sub

Sub Example_IntersectWith()     Dim xlApp As Object    ' This Line ,Not set Excel , run Excel     'Dim xlsheet As Object         ' 发生错误时跳到下一个语句继续执行     On Error Resume Next     ' 连接Excel应用程序     Set xlApp = GetObject(, "Excel.Application")         If Err.Number <> 0 Then         Set xlApp = CreateObject("Excel.Application")         xlApp.Visible = True         xlApp.Workbooks.Add     End If     ' 返回当前活动的工作表     'Set xlsheet = xlApp.ActiveSheet     Set xlSheet = xlApp.sheets(1)     ' This example creates a line and circle and finds the points at     ' which they intersect.     Dim oBject As AcadEntity, oBject1 As AcadEntity     Dim ii As Integer, jj As Integer     Dim Ppt As Variant     nn = 1     For ii = 0 To ThisDrawing.ModelSpace.Count - 1              Set oBject = ThisDrawing.ModelSpace.Item(ii)              For jj = 0 To ThisDrawing.ModelSpace.Count - 1         Set oBject1 = ThisDrawing.ModelSpace.Item(jj)                Ppt = oBject1.IntersectWith(oBject, acExtendOtherEntity)         xlSheet.Cells(nn, 1).Value = Format(Ppt(0), "0.0")         xlSheet.Cells(nn, 2).Value = Format(Ppt(1), "0.0")         xlSheet.Cells(nn, 3).Value = Ppt(2)         Debug.Print Ppt(0), Ppt(1), Ppt(2)         Debug.Print nn, oBject.Handle, oBject1.Handle         xlSheet.Cells(nn, 4).Value = nn         nn = nn + 1       Next jj     Next ii     End Sub

在Excel中计算的结果。
交点坐标顺序X点Y点Z点第1点-743-37.60第2点-739-86.10第3点-738.6-300第4点-732.5-130.20第5点-724.1-1710第6点-721.300第7点-714-209.10第8点-706.6-300第9点-704300

兰州人

上面程序运行在Excel结果如下。

928.1	201.2	0
666.4	472.8	0
819.6	313.7	0
928.1	201.2	0
1239.2	593	0
1051.1	356.1	0
1239.2	593	0
1002.6	765.5	0

采用SQL - Select进行不重复数据处理。

Sub ls()
  Dim Sql$   ', Cnn As ADODB.Connection
  Dim Rst As ADODB.Recordset
  Set Cnn = CreateObject("ADODB.Connection")
  Cnn.Open "Provider = MicroSoft.Jet.OLEDB.4.0; Extended Properties = Excel 8.0; Data Source = " & "k:\ls.xls"
 
  Sql = "Select distinct * from [Sheet1$]"
  Set Rst = Cnn.Execute(Sql)
  Sheets(2).Range("A1").CopyFromRecordset Rst
 
End Sub

646.8	282.1	0
666.4	472.8	0
693.6	737.8	0
819.6	313.7	0
928.1	201.2	0
1002.6	765.5	0
1051.1	356.1	0
1239.2	593	0
1239.2	593	0

兰州人

ADO+EXCEL通用程序样版。

Sub ADORecordset()
    Dim Sql$
    Dim RST As New ADODB.Recordset '若要使用 RST.RecordCount 计算记录个数，此项必须，故一定要设置引用：
                                   'VBE 中菜单“工具－引用－Microsoft ActiveX Data Objects 2.0 Library”
                                                     '（1）定义对象
    Set Conn = CreateObject("adodb.connection")      '（2）设置 connection 对象
    Set RST = CreateObject("Adodb.Recordset")        '（3）设置 Recordset 对象
    Conn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName
                                                     '（4）打开连接
    Sql = "Select * from [Sheet1$] where 字段='020009' or 字段='050023' or 字段='010024'"
                                                     '（5）设置 Sql 语句
    RST.Open Sql, Conn, adOpenStatic                    'adOpenStatic静态指针，以便计算记录个数
                                                     '（6）执行 Sql 语句
    MsgBox "找到" & RST.RecordCount & "个记录"        '（7）可使用 RST.RecordCount 得到记录个数
    Sheets(2).Range("a2").CopyFromRecordset RST      '（8）结果放置
    Sheets(2).Activate
   
    RST.Close: Conn.Close                            '（9）关闭连接
    Set RST = Nothing: Set Conn = Nothing            '（10）对象置空
End Sub

'使用 ADO-SQL 处理 EXCEL 文件的程序架构一

Sub ADOConn()
    Dim Sql$
    Set Conn = CreateObject("adodb.connection")
    Conn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName
    'Sql = "select * from [Sheet1$] where Part NO#='020009' or Part NO#='050023' or Part NO#='010024'"
    'Sql = "select PartNO from [Sheet1$] where PartNO='020009'"
    Sql = "Select * from [Sheet1$] where 字段='020009' or 字段='050023' or 字段='010024'"
    Sheets(2).Range("a2").CopyFromRecordset Conn.Execute(Sql)
    Sheets(2).Activate
    Conn.Close
    Set Conn = Nothing
End Sub

qxfeng

赞兰州人，压力容器的设计确需要动脑筋。不知三维软件INVENTOR有没有研究过？也许能帮得上忙。

liushuaijie

有图纸说明的吗？

kent1968

学习了

254619324

兰州人，对压力容器以及相关软件的开发，确实厉害，有你的好几个软件，在学习呢