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

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方法[code]
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

fimbotp25us.jpg