[原创]功能函数返回数组变量数组--执行pline

兰州人

此图形是HG20595的一个剖面图形。解决方法是用ADO+数组+poyline方法安成。
程序如下：

2. Option Explicit
3. Const Pi = 3.14159265358979
4. Dim adoCon As New ADODB.Connection
5. ' 功能：打开指定的数据库（在frmConnectDB中指定）
6. ' 输入：无
7. ' 调用：无
8. ' 返回：如果完成连接，返回True；否则返回False
9. ' 示例：
10. '       OpenDB
11. Public Function OpenDB(InputDataBaseName) As Boolean
12.     OpenDB = True
13.    
14.     ' 如果数据库已打开，不执行任何操作
15.     If adoCon.State <> 0 Then Exit Function
16.    
17.     adoCon.CursorLocation = adUseClient
18.    
19.     ' 获得数据库文件的位置
20.     Dim strDbName As String
21.     Dim strProject As String
22.     strProject = Left(ThisDrawing.Application.VBE.activevbProject.FileName, _
23.                     Len(ThisDrawing.Application.VBE.activevbProject.FileName) - 19)
24.     strDbName = strProject & "\mdb" & InputDataBaseName & ".mdb"
25.     adoCon.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
26.         strDbName & ";"
27. End Function
28. ' 功能：关闭指定的数据库（在frmConnectDB中指定）
29. ' 输入：无
30. ' 调用：无
31. ' 返回：如果数据库处于打开状态，就关闭它
32. ' 示例：
33. '       CloseDB
34. Public Function CloseDB()
35.     If adoCon.State <> 0 Then
36.         adoCon.Close
37.     End If
38. End Function
39. Function HG20595T_Data_Preparation() As Double()
40.   Dim d1, f2, x, w, c, n1, n, h, k, h1, d, l, PipeOutDiameter, PipeDelta, a1, rr, i, ScheduleWall, SeriesNo
41.   Dim HG20595(12, 3) As Double
42. '
43.   Dim startpoint(0 To 2) As Double
44.   Dim endpoint(0 To 2) As Double
45. '
46. '面域
47.   Dim curves(0 To 12) As AcadEntity
48.   Dim regionObj As Variant
49. '旋转实体
50.   Dim axisPt(0 To 2) As Double
51.   Dim axisDir(0 To 2) As Double
52.   Dim angle As Double
53. '开孔
54.   Dim cylinderObj As Acad3DSolid
55.   Dim radius As Double
56.   Dim center(0 To 2) As Double
57.   Dim height As Double
58.   height = 500
59.   axisPt(0) = 0: axisPt(1) = 0: axisPt(2) = 0
60.   axisDir(0) = 0: axisDir(1) = 0: axisDir(2) = 1
61.   angle = Pi * 2 + 0.2
62.   Dim solidObj As Acad3DSolid
63.   Dim Sep_N, Pn As String, Dn As String, SearchCondition
64.   Pn = 6.3: Dn = 350
65.   Select Case Pn
66.     Case 1#, 10#, 16#, 25#
67.       SearchCondition = Dn & "-" & Trim(Str(Pn) + ".0")
68.     Case Else
69.       SearchCondition = Dn & "-" & Trim(Str(Pn))
70.   End Select
71.   
72. '
73.   ''
74.   OpenDB ("HG20592")
75.   '
76.   Dim rst As New ADODB.Recordset
77.   Dim Sql As String, ii As Integer
78.   Sql = "select c.*,a.*,b.* from 带颈对焊法兰  as A,凹凸榫槽密封面 as b ,法兰规格 as c Where " & _
79.       " c.法兰规格 = '" & SearchCondition & "' and c.法兰规格 = a.法兰规格 and c.法兰规格 = b.法兰规格"
80.   rst.Open Sql, adoCon, adOpenDynamic, adLockOptimistic
81.   ''
82.    
83.     ScheduleWall = 12: SeriesNo = "B"
84. '    d1 = rst.Fields("突台外径d"):
85.     f2 = rst.Fields("台高f2"):
86.     x = rst.Fields("凸面外径X"):
87.     w = rst.Fields("榫面内径W")
88.    
89.    
90. '''
91.     c = rst.Fields("WN法兰厚度C")  '
92.     Select Case SeriesNo
93.       Case "A"
94.         n1 = rst.Fields("WN法兰颈径NA")
95.         PipeOutDiameter = rst.Fields("钢管外径A")
96.       Case "B"
97.         n1 = rst.Fields("WN法兰颈径NB")
98.         PipeOutDiameter = rst.Fields("钢管外径B")
99.     End Select
100.     n = rst.Fields("螺栓数量") 'xxlSheet.cells(ii, 16).Value
101.     h = rst.Fields("WN法兰高度H")  'xxlSheet.cells(ii, 10).Value
102.     k = rst.Fields("螺栓孔中心圆直径")  'xxlSheet.cells(ii, 13).Value
103.     h1 = rst.Fields("WN焊端长度h")
104.     d = rst.Fields("法兰外径D")  'xxlSheet.cells(ii, 12).Value
105.     l = rst.Fields("螺栓孔直径")  'xxlSheet.cells(ii, 14).Value
106.    
107.     PipeDelta = ScheduleWall
108.     a1 = PipeOutDiameter
109.     rr = rst.Fields("WN圆角半径R")
110.   CloseDB
111. ' HG20595法兰实体赋值
112.     ThisDrawing.SendCommand "_fillet" + Chr(10) + "r" & Chr(10) & rr & Chr(10) & Chr(10)
113.     HG20595(1, 1) = (PipeOutDiameter - 2 * PipeDelta) / 2: HG20595(1, 2) = -f2: HG20595(1, 3) = 0
114.     HG20595(2, 1) = w / 2: HG20595(2, 2) = -f2: HG20595(2, 3) = 0
115.     HG20595(3, 1) = w / 2: HG20595(3, 2) = 0: HG20595(3, 3) = 0
116.     HG20595(4, 1) = x / 2: HG20595(4, 2) = 0: HG20595(4, 3) = 0
117.     HG20595(5, 1) = x / 2: HG20595(5, 2) = -f2: HG20595(5, 3) = 0
118.     HG20595(6, 1) = d / 2: HG20595(6, 2) = -f2: HG20595(6, 3) = 0
119.     HG20595(7, 1) = d / 2: HG20595(7, 2) = -c: HG20595(7, 3) = 0
120.     HG20595(8, 1) = n1 / 2: HG20595(8, 2) = -c: HG20595(8, 3) = 0
121.     HG20595(9, 1) = a1 / 2: HG20595(9, 2) = h1 - h: HG20595(9, 3) = 0
122.     HG20595(10, 1) = a1 / 2: HG20595(10, 2) = -h: HG20595(10, 3) = 0
123.     HG20595(11, 1) = (PipeOutDiameter - 2 * PipeDelta) / 2: HG20595(11, 2) = -h: HG20595(11, 3) = 0
124.     HG20595(12, 1) = (PipeOutDiameter - 2 * PipeDelta) / 2: HG20595(12, 2) = -f2: HG20595(12, 3) = 0
125.     HG20595T_Data_Preparation = HG20595
126. End Function
127. Sub lss()
128.   Dim AA() As Double, bb() As Double, ii, jj, nn
129.   Debug.Print TypeName(HG20595T_Data_Preparation)
130.   
131.   AA = HG20595T_Data_Preparation
132.   ReDim bb(UBound(AA) * 3 - 1) As Double
133.   Debug.Print UBound(bb)
134.   
135.   For ii = 1 To UBound(AA)
136.     For jj = 1 To 3
137.       bb(nn) = AA(ii, jj)
138.       nn = nn + 1
139.     Next jj
140.   Next ii
141.   Dim ppl As AcadPolyline
142.   Set ppl = ThisDrawing.ModelSpace.AddPolyline(bb)
143. End Sub

Option Explicit Const Pi = 3.14159265358979 Dim adoCon As New ADODB.Connection ' 功能：打开指定的数据库（在frmConnectDB中指定） ' 输入：无 ' 调用：无 ' 返回：如果完成连接，返回True；否则返回False ' 示例： '       OpenDB Public Function OpenDB(InputDataBaseName) As Boolean     OpenDB = True         ' 如果数据库已打开，不执行任何操作     If adoCon.State <> 0 Then Exit Function         adoCon.CursorLocation = adUseClient         ' 获得数据库文件的位置     Dim strDbName As String     Dim strProject As String     strProject = Left(ThisDrawing.Application.VBE.activevbProject.FileName, _                     Len(ThisDrawing.Application.VBE.activevbProject.FileName) - 19)     strDbName = strProject & "\mdb" & InputDataBaseName & ".mdb"     adoCon.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _         strDbName & ";" End Function ' 功能：关闭指定的数据库（在frmConnectDB中指定） ' 输入：无 ' 调用：无 ' 返回：如果数据库处于打开状态，就关闭它 ' 示例： '       CloseDB Public Function CloseDB()     If adoCon.State <> 0 Then         adoCon.Close     End If End Function Function HG20595T_Data_Preparation() As Double()   Dim d1, f2, x, w, c, n1, n, h, k, h1, d, l, PipeOutDiameter, PipeDelta, a1, rr, i, ScheduleWall, SeriesNo   Dim HG20595(12, 3) As Double '   Dim startpoint(0 To 2) As Double   Dim endpoint(0 To 2) As Double ' '面域   Dim curves(0 To 12) As AcadEntity   Dim regionObj As Variant '旋转实体   Dim axisPt(0 To 2) As Double   Dim axisDir(0 To 2) As Double   Dim angle As Double '开孔   Dim cylinderObj As Acad3DSolid   Dim radius As Double   Dim center(0 To 2) As Double   Dim height As Double   height = 500   axisPt(0) = 0: axisPt(1) = 0: axisPt(2) = 0   axisDir(0) = 0: axisDir(1) = 0: axisDir(2) = 1   angle = Pi * 2 + 0.2   Dim solidObj As Acad3DSolid   Dim Sep_N, Pn As String, Dn As String, SearchCondition   Pn = 6.3: Dn = 350   Select Case Pn     Case 1#, 10#, 16#, 25#       SearchCondition = Dn & "-" & Trim(Str(Pn) + ".0")     Case Else       SearchCondition = Dn & "-" & Trim(Str(Pn))   End Select    '   ''   OpenDB ("HG20592")   '   Dim rst As New ADODB.Recordset   Dim Sql As String, ii As Integer   Sql = "select c.*,a.*,b.* from 带颈对焊法兰  as A,凹凸榫槽密封面 as b ,法兰规格 as c Where " & _       " c.法兰规格 = '" & SearchCondition & "' and c.法兰规格 = a.法兰规格 and c.法兰规格 = b.法兰规格"   rst.Open Sql, adoCon, adOpenDynamic, adLockOptimistic   ''         ScheduleWall = 12: SeriesNo = "B" '    d1 = rst.Fields("突台外径d"):     f2 = rst.Fields("台高f2"):     x = rst.Fields("凸面外径X"):     w = rst.Fields("榫面内径W")         '''     c = rst.Fields("WN法兰厚度C")  '     Select Case SeriesNo       Case "A"         n1 = rst.Fields("WN法兰颈径NA")         PipeOutDiameter = rst.Fields("钢管外径A")       Case "B"         n1 = rst.Fields("WN法兰颈径NB")         PipeOutDiameter = rst.Fields("钢管外径B")     End Select     n = rst.Fields("螺栓数量") 'xxlSheet.cells(ii, 16).Value     h = rst.Fields("WN法兰高度H")  'xxlSheet.cells(ii, 10).Value     k = rst.Fields("螺栓孔中心圆直径")  'xxlSheet.cells(ii, 13).Value     h1 = rst.Fields("WN焊端长度h")     d = rst.Fields("法兰外径D")  'xxlSheet.cells(ii, 12).Value     l = rst.Fields("螺栓孔直径")  'xxlSheet.cells(ii, 14).Value         PipeDelta = ScheduleWall     a1 = PipeOutDiameter     rr = rst.Fields("WN圆角半径R")   CloseDB ' HG20595法兰实体赋值     ThisDrawing.SendCommand "_fillet" + Chr(10) + "r" & Chr(10) & rr & Chr(10) & Chr(10)     HG20595(1, 1) = (PipeOutDiameter - 2 * PipeDelta) / 2: HG20595(1, 2) = -f2: HG20595(1, 3) = 0     HG20595(2, 1) = w / 2: HG20595(2, 2) = -f2: HG20595(2, 3) = 0     HG20595(3, 1) = w / 2: HG20595(3, 2) = 0: HG20595(3, 3) = 0     HG20595(4, 1) = x / 2: HG20595(4, 2) = 0: HG20595(4, 3) = 0     HG20595(5, 1) = x / 2: HG20595(5, 2) = -f2: HG20595(5, 3) = 0     HG20595(6, 1) = d / 2: HG20595(6, 2) = -f2: HG20595(6, 3) = 0     HG20595(7, 1) = d / 2: HG20595(7, 2) = -c: HG20595(7, 3) = 0     HG20595(8, 1) = n1 / 2: HG20595(8, 2) = -c: HG20595(8, 3) = 0     HG20595(9, 1) = a1 / 2: HG20595(9, 2) = h1 - h: HG20595(9, 3) = 0     HG20595(10, 1) = a1 / 2: HG20595(10, 2) = -h: HG20595(10, 3) = 0     HG20595(11, 1) = (PipeOutDiameter - 2 * PipeDelta) / 2: HG20595(11, 2) = -h: HG20595(11, 3) = 0     HG20595(12, 1) = (PipeOutDiameter - 2 * PipeDelta) / 2: HG20595(12, 2) = -f2: HG20595(12, 3) = 0     HG20595T_Data_Preparation = HG20595 End Function Sub lss()   Dim AA() As Double, bb() As Double, ii, jj, nn   Debug.Print TypeName(HG20595T_Data_Preparation)      AA = HG20595T_Data_Preparation   ReDim bb(UBound(AA) * 3 - 1) As Double   Debug.Print UBound(bb)      For ii = 1 To UBound(AA)     For jj = 1 To 3       bb(nn) = AA(ii, jj)       nn = nn + 1     Next jj   Next ii   Dim ppl As AcadPolyline   Set ppl = ThisDrawing.ModelSpace.AddPolyline(bb) End Sub

type ---- type end方法

2. Option Explicit
3. Const Pi = 3.14159265358979
4. Dim adoCon As New ADODB.Connection
5. Private Type HG20595InitialData
6.   HG20595 As Variant '(12, 3) As Double
7.   n As Double
8.   k As Double
9.   l As Double
10. End Type
11. ' 功能：打开指定的数据库（在frmConnectDB中指定）
12. ' 输入：无
13. ' 调用：无
14. ' 返回：如果完成连接，返回True；否则返回False
15. ' 示例：
16. '       OpenDB
17. Public Function OpenDB(InputDataBaseName) As Boolean
18.     OpenDB = True
19.    
20.     ' 如果数据库已打开，不执行任何操作
21.     If adoCon.State <> 0 Then Exit Function
22.    
23.     adoCon.CursorLocation = adUseClient
24.    
25.     ' 获得数据库文件的位置
26.     Dim strDbName As String
27.     Dim strProject As String
28.     strProject = Left(ThisDrawing.Application.VBE.activevbProject.FileName, _
29.                     Len(ThisDrawing.Application.VBE.activevbProject.FileName) - 19)
30.     strDbName = strProject & "\mdb" & InputDataBaseName & ".mdb"
31.     adoCon.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
32.         strDbName & ";"
33. End Function
34. ' 功能：关闭指定的数据库（在frmConnectDB中指定）
35. ' 输入：无
36. ' 调用：无
37. ' 返回：如果数据库处于打开状态，就关闭它
38. ' 示例：
39. '       CloseDB
40. Public Function CloseDB()
41.     If adoCon.State <> 0 Then
42.         adoCon.Close
43.     End If
44. End Function
45. Function HG20595T_Data_Preparation() As HG20595InitialData
46.   Dim d1, f2, x, w, c, n1, n, h, k, h1, d, l, PipeOutDiameter, PipeDelta, a1, rr, i, ScheduleWall, SeriesNo
47. '
48.   ''
49.   OpenDB ("HG20592")
50.   '
51.   Dim rst As New ADODB.Recordset
52.   Dim Sql As String, ii As Integer
53.   
54. ''
55.   Dim Sep_N, Pn As String, Dn As String, SearchCondition
56.   Pn = 6.3: Dn = 350
57.   Select Case Pn
58.     Case 1#, 10#, 16#, 25#
59.       SearchCondition = Dn & "-" & Trim(Str(Pn) + ".0")
60.     Case Else
61.       SearchCondition = Dn & "-" & Trim(Str(Pn))
62.   End Select
63. ''
64.   Sql = "select c.*,a.*,b.* from 带颈对焊法兰  as A,凹凸榫槽密封面 as b ,法兰规格 as c Where " & _
65.       " c.法兰规格 = '" & SearchCondition & "' and c.法兰规格 = a.法兰规格 and c.法兰规格 = b.法兰规格"
66.   rst.Open Sql, adoCon, adOpenDynamic, adLockOptimistic
67.   ''
68.    
69.     ScheduleWall = 12: SeriesNo = "B"
70. '    d1 = rst.Fields("突台外径d"):
71.     f2 = rst.Fields("台高f2"):
72.     x = rst.Fields("凸面外径X"):
73.     w = rst.Fields("榫面内径W")
74.    
75.    
76. '''
77.     c = rst.Fields("WN法兰厚度C")  '
78.     Select Case SeriesNo
79.       Case "A"
80.         n1 = rst.Fields("WN法兰颈径NA")
81.         PipeOutDiameter = rst.Fields("钢管外径A")
82.       Case "B"
83.         n1 = rst.Fields("WN法兰颈径NB")
84.         PipeOutDiameter = rst.Fields("钢管外径B")
85.     End Select
86.     HG20595T_Data_Preparation.n = rst.Fields("螺栓数量") 'xxlSheet.cells(ii, 16).Value
87.     h = rst.Fields("WN法兰高度H")  'xxlSheet.cells(ii, 10).Value
88.     HG20595T_Data_Preparation.k = rst.Fields("螺栓孔中心圆直径")  'xxlSheet.cells(ii, 13).Value
89.    
90.    
91.     h1 = rst.Fields("WN焊端长度h")
92.     d = rst.Fields("法兰外径D")  'xxlSheet.cells(ii, 12).Value
93.     HG20595T_Data_Preparation.l = rst.Fields("螺栓孔直径")  'xxlSheet.cells(ii, 14).Value
94.    
95.     PipeDelta = ScheduleWall
96.     a1 = PipeOutDiameter
97.     rr = rst.Fields("WN圆角半径R")
98.   CloseDB
99. ' HG20595法兰实体赋值
100.     Dim HG20595(12, 3) As Double
101.     ThisDrawing.SendCommand "_fillet" + Chr(10) + "r" & Chr(10) & rr & Chr(10) & Chr(10)
102.     HG20595(1, 1) = (PipeOutDiameter - 2 * PipeDelta) / 2: HG20595(1, 2) = -f2: HG20595(1, 3) = 0
103.     HG20595(2, 1) = w / 2: HG20595(2, 2) = -f2: HG20595(2, 3) = 0
104.     HG20595(3, 1) = w / 2: HG20595(3, 2) = 0: HG20595(3, 3) = 0
105.     HG20595(4, 1) = x / 2: HG20595(4, 2) = 0: HG20595(4, 3) = 0
106.     HG20595(5, 1) = x / 2: HG20595(5, 2) = -f2: HG20595(5, 3) = 0
107.     HG20595(6, 1) = d / 2: HG20595(6, 2) = -f2: HG20595(6, 3) = 0
108.     HG20595(7, 1) = d / 2: HG20595(7, 2) = -c: HG20595(7, 3) = 0
109.     HG20595(8, 1) = n1 / 2: HG20595(8, 2) = -c: HG20595(8, 3) = 0
110.     HG20595(9, 1) = a1 / 2: HG20595(9, 2) = h1 - h: HG20595(9, 3) = 0
111.     HG20595(10, 1) = a1 / 2: HG20595(10, 2) = -h: HG20595(10, 3) = 0
112.     HG20595(11, 1) = (PipeOutDiameter - 2 * PipeDelta) / 2: HG20595(11, 2) = -h: HG20595(11, 3) = 0
113.     HG20595(12, 1) = (PipeOutDiameter - 2 * PipeDelta) / 2: HG20595(12, 2) = -f2: HG20595(12, 3) = 0
114.     HG20595T_Data_Preparation.HG20595 = HG20595
115. End Function
116. Sub lss()
117.   Dim aa() As Double, bb() As Double, ii, jj, nn
118.   Dim ee As AcadEntity
119.   Set ee = DrawingEntityForHG20595T(HG20595T_Data_Preparation.HG20595 _
120.      , HG20595T_Data_Preparation.l, HG20595T_Data_Preparation.n, HG20595T_Data_Preparation.k)
121. End Sub
122. Function DrawingEntityForHG20595T(HG20595 As Variant, l, n, k) As AcadEntity
123.   'Dim HG20595(12, 3) As Double
124.   'Dim HG20595
125.   'HG20595 = HG20595InputData
126. '
127.   Dim startpoint(0 To 2) As Double
128.   Dim endpoint(0 To 2) As Double
129. '
130. '面域
131.   Dim curves(0 To 12) As AcadEntity
132.   Dim regionObj As Variant
133. '旋转实体
134.   Dim axisPt(0 To 2) As Double
135.   Dim axisDir(0 To 2) As Double
136.   Dim angle As Double
137. '开孔
138.   Dim cylinderObj As Acad3DSolid
139.   Dim radius As Double
140.   Dim center(0 To 2) As Double
141.   Dim height As Double
142.   height = 500
143.   axisPt(0) = 0: axisPt(1) = 0: axisPt(2) = 0
144.   axisDir(0) = 0: axisDir(1) = 0: axisDir(2) = 1
145.   angle = Pi * 2 + 0.2
146.   Dim solidObj As Acad3DSolid
147.    Dim i
148.    For i = 1 To 11
149.       startpoint(0) = HG20595(i, 0): startpoint(1) = HG20595(i, 1): startpoint(2) = HG20595(i, 2)
150.     If i <= 12 Then
151.          endpoint(0) = HG20595(i + 1, 0): endpoint(1) = HG20595(i + 1, 1): endpoint(2) = HG20595(i + 1, 2)
152.     End If
153.     Set curves(i - 1) = ThisDrawing.ModelSpace.AddLine(startpoint, endpoint)
154.     Next i
155.     Dim str_handle1, str_handle2
156.     str_handle1 = curves(6).Handle
157.     str_handle2 = curves(7).Handle
158.     ThisDrawing.SendCommand "_fillet" + Chr(10) + "(Handent" & Chr(34) & str_handle1 & Chr(34) & ")" & Chr(10) & "(Handent" & Chr(34) & str_handle2 & Chr(34) & ")" & Chr(10)
159.     Set curves(11) = ThisDrawing.ModelSpace.Item(ThisDrawing.ModelSpace.Count - 1)
160.     str_handle1 = curves(7).Handle
161.     str_handle2 = curves(8).Handle
162.     ThisDrawing.SendCommand "_fillet" + Chr(10) + "(Handent" & Chr(34) & str_handle1 & Chr(34) & ")" & Chr(10) & "(Handent" & Chr(34) & str_handle2 & Chr(34) & ")" & Chr(10)
163.     Set curves(12) = ThisDrawing.ModelSpace.Item(ThisDrawing.ModelSpace.Count - 1)
164. '面域绘制
165.     regionObj = ThisDrawing.ModelSpace.AddRegion(curves)
166.     For i = 0 To 12
167.      curves(i).Delete
168.     Next i
169. '实体旋转
170.          
171.     Set solidObj = ThisDrawing.ModelSpace.AddRevolvedSolid(regionObj(0), axisPt, axisDir, angle)
172.     regionObj(0).Delete
173. '开孔
174.         
175.     Dim Alfa
176.         
177.     radius = l / 2
178.    
179.     Alfa = Pi / n
180.     For i = 1 To n
181.       center(0) = k / 2 * Cos(Alfa): center(1) = k / 2 * Sin(Alfa): center(2) = 0
182.     Set cylinderObj = ThisDrawing.ModelSpace.AddCylinder(center, radius, height)
183. '剪切
184.     solidObj.Boolean 2, cylinderObj
185.     Alfa = Alfa + 2 * Pi / n
186.     Next i
187. ''''
188. End Function

Option Explicit Const Pi = 3.14159265358979 Dim adoCon As New ADODB.Connection Private Type HG20595InitialData   HG20595 As Variant '(12, 3) As Double   n As Double   k As Double   l As Double End Type ' 功能：打开指定的数据库（在frmConnectDB中指定） ' 输入：无 ' 调用：无 ' 返回：如果完成连接，返回True；否则返回False ' 示例： '       OpenDB Public Function OpenDB(InputDataBaseName) As Boolean     OpenDB = True         ' 如果数据库已打开，不执行任何操作     If adoCon.State <> 0 Then Exit Function         adoCon.CursorLocation = adUseClient         ' 获得数据库文件的位置     Dim strDbName As String     Dim strProject As String     strProject = Left(ThisDrawing.Application.VBE.activevbProject.FileName, _                     Len(ThisDrawing.Application.VBE.activevbProject.FileName) - 19)     strDbName = strProject & "\mdb" & InputDataBaseName & ".mdb"     adoCon.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _         strDbName & ";" End Function ' 功能：关闭指定的数据库（在frmConnectDB中指定） ' 输入：无 ' 调用：无 ' 返回：如果数据库处于打开状态，就关闭它 ' 示例： '       CloseDB Public Function CloseDB()     If adoCon.State <> 0 Then         adoCon.Close     End If End Function Function HG20595T_Data_Preparation() As HG20595InitialData   Dim d1, f2, x, w, c, n1, n, h, k, h1, d, l, PipeOutDiameter, PipeDelta, a1, rr, i, ScheduleWall, SeriesNo '   ''   OpenDB ("HG20592")   '   Dim rst As New ADODB.Recordset   Dim Sql As String, ii As Integer    ''   Dim Sep_N, Pn As String, Dn As String, SearchCondition   Pn = 6.3: Dn = 350   Select Case Pn     Case 1#, 10#, 16#, 25#       SearchCondition = Dn & "-" & Trim(Str(Pn) + ".0")     Case Else       SearchCondition = Dn & "-" & Trim(Str(Pn))   End Select ''   Sql = "select c.*,a.*,b.* from 带颈对焊法兰  as A,凹凸榫槽密封面 as b ,法兰规格 as c Where " & _       " c.法兰规格 = '" & SearchCondition & "' and c.法兰规格 = a.法兰规格 and c.法兰规格 = b.法兰规格"   rst.Open Sql, adoCon, adOpenDynamic, adLockOptimistic   ''         ScheduleWall = 12: SeriesNo = "B" '    d1 = rst.Fields("突台外径d"):     f2 = rst.Fields("台高f2"):     x = rst.Fields("凸面外径X"):     w = rst.Fields("榫面内径W")         '''     c = rst.Fields("WN法兰厚度C")  '     Select Case SeriesNo       Case "A"         n1 = rst.Fields("WN法兰颈径NA")         PipeOutDiameter = rst.Fields("钢管外径A")       Case "B"         n1 = rst.Fields("WN法兰颈径NB")         PipeOutDiameter = rst.Fields("钢管外径B")     End Select     HG20595T_Data_Preparation.n = rst.Fields("螺栓数量") 'xxlSheet.cells(ii, 16).Value     h = rst.Fields("WN法兰高度H")  'xxlSheet.cells(ii, 10).Value     HG20595T_Data_Preparation.k = rst.Fields("螺栓孔中心圆直径")  'xxlSheet.cells(ii, 13).Value             h1 = rst.Fields("WN焊端长度h")     d = rst.Fields("法兰外径D")  'xxlSheet.cells(ii, 12).Value     HG20595T_Data_Preparation.l = rst.Fields("螺栓孔直径")  'xxlSheet.cells(ii, 14).Value         PipeDelta = ScheduleWall     a1 = PipeOutDiameter     rr = rst.Fields("WN圆角半径R")   CloseDB ' HG20595法兰实体赋值     Dim HG20595(12, 3) As Double     ThisDrawing.SendCommand "_fillet" + Chr(10) + "r" & Chr(10) & rr & Chr(10) & Chr(10)     HG20595(1, 1) = (PipeOutDiameter - 2 * PipeDelta) / 2: HG20595(1, 2) = -f2: HG20595(1, 3) = 0     HG20595(2, 1) = w / 2: HG20595(2, 2) = -f2: HG20595(2, 3) = 0     HG20595(3, 1) = w / 2: HG20595(3, 2) = 0: HG20595(3, 3) = 0     HG20595(4, 1) = x / 2: HG20595(4, 2) = 0: HG20595(4, 3) = 0     HG20595(5, 1) = x / 2: HG20595(5, 2) = -f2: HG20595(5, 3) = 0     HG20595(6, 1) = d / 2: HG20595(6, 2) = -f2: HG20595(6, 3) = 0     HG20595(7, 1) = d / 2: HG20595(7, 2) = -c: HG20595(7, 3) = 0     HG20595(8, 1) = n1 / 2: HG20595(8, 2) = -c: HG20595(8, 3) = 0     HG20595(9, 1) = a1 / 2: HG20595(9, 2) = h1 - h: HG20595(9, 3) = 0     HG20595(10, 1) = a1 / 2: HG20595(10, 2) = -h: HG20595(10, 3) = 0     HG20595(11, 1) = (PipeOutDiameter - 2 * PipeDelta) / 2: HG20595(11, 2) = -h: HG20595(11, 3) = 0     HG20595(12, 1) = (PipeOutDiameter - 2 * PipeDelta) / 2: HG20595(12, 2) = -f2: HG20595(12, 3) = 0     HG20595T_Data_Preparation.HG20595 = HG20595 End Function Sub lss()   Dim aa() As Double, bb() As Double, ii, jj, nn   Dim ee As AcadEntity   Set ee = DrawingEntityForHG20595T(HG20595T_Data_Preparation.HG20595 _      , HG20595T_Data_Preparation.l, HG20595T_Data_Preparation.n, HG20595T_Data_Preparation.k) End Sub Function DrawingEntityForHG20595T(HG20595 As Variant, l, n, k) As AcadEntity   'Dim HG20595(12, 3) As Double   'Dim HG20595   'HG20595 = HG20595InputData '   Dim startpoint(0 To 2) As Double   Dim endpoint(0 To 2) As Double ' '面域   Dim curves(0 To 12) As AcadEntity   Dim regionObj As Variant '旋转实体   Dim axisPt(0 To 2) As Double   Dim axisDir(0 To 2) As Double   Dim angle As Double '开孔   Dim cylinderObj As Acad3DSolid   Dim radius As Double   Dim center(0 To 2) As Double   Dim height As Double   height = 500   axisPt(0) = 0: axisPt(1) = 0: axisPt(2) = 0   axisDir(0) = 0: axisDir(1) = 0: axisDir(2) = 1   angle = Pi * 2 + 0.2   Dim solidObj As Acad3DSolid    Dim i    For i = 1 To 11       startpoint(0) = HG20595(i, 0): startpoint(1) = HG20595(i, 1): startpoint(2) = HG20595(i, 2)     If i <= 12 Then          endpoint(0) = HG20595(i + 1, 0): endpoint(1) = HG20595(i + 1, 1): endpoint(2) = HG20595(i + 1, 2)     End If     Set curves(i - 1) = ThisDrawing.ModelSpace.AddLine(startpoint, endpoint)     Next i     Dim str_handle1, str_handle2     str_handle1 = curves(6).Handle     str_handle2 = curves(7).Handle     ThisDrawing.SendCommand "_fillet" + Chr(10) + "(Handent" & Chr(34) & str_handle1 & Chr(34) & ")" & Chr(10) & "(Handent" & Chr(34) & str_handle2 & Chr(34) & ")" & Chr(10)     Set curves(11) = ThisDrawing.ModelSpace.Item(ThisDrawing.ModelSpace.Count - 1)     str_handle1 = curves(7).Handle     str_handle2 = curves(8).Handle     ThisDrawing.SendCommand "_fillet" + Chr(10) + "(Handent" & Chr(34) & str_handle1 & Chr(34) & ")" & Chr(10) & "(Handent" & Chr(34) & str_handle2 & Chr(34) & ")" & Chr(10)     Set curves(12) = ThisDrawing.ModelSpace.Item(ThisDrawing.ModelSpace.Count - 1) '面域绘制     regionObj = ThisDrawing.ModelSpace.AddRegion(curves)     For i = 0 To 12      curves(i).Delete     Next i '实体旋转               Set solidObj = ThisDrawing.ModelSpace.AddRevolvedSolid(regionObj(0), axisPt, axisDir, angle)     regionObj(0).Delete '开孔              Dim Alfa              radius = l / 2         Alfa = Pi / n     For i = 1 To n       center(0) = k / 2 * Cos(Alfa): center(1) = k / 2 * Sin(Alfa): center(2) = 0     Set cylinderObj = ThisDrawing.ModelSpace.AddCylinder(center, radius, height) '剪切     solidObj.Boolean 2, cylinderObj     Alfa = Alfa + 2 * Pi / n     Next i '''' End Function

运行结果如图所示，三维HG20595-T型法兰

sunny2008

谢谢！努力学习中

火龙果2022

谢谢，非常好，学习一下！让我们共同努力，共创论坛美好未来！