constructcls.cls

该程序是按照矩阵位移法的后处理法的基本原理和分析过程

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "ConstructCls"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private NN As Integer    '结点总数
Private NE As Integer   '单元总数
Private NLN As Integer  '受荷载的结点总数
Private NBN As Integer  '支座结点总数
'Private NNE As Integer  '每个单元的结点数（对于杆系结构等于2）
'Private NDF As Integer  '每个结点的自由度（对于平面钢架等于3）
Private NDFEL As Integer '每个单元的自由度数，NDFEL=NDF*NNE
Private NRMX As Integer 'TK数组的最大行数，TK数组用于存放总刚度矩阵
Private NCMX As Integer 'TK数组的最大列数，即允许的总刚度矩阵的最大半带宽
Private N As Integer    '结点的位移总数，N=NDF*NN,N即为实际结构总刚度矩阵的阶数
Private MS As Integer   '实际结构总刚度矩阵的半宽度
Private E As Double     '材料的弹性模量
Private G As Double

Private NCO() As Integer    '各单元两端的结点号，一维数组，按单元编号顺序存放
Private IB() As Integer     '支座结点的位移状态，一位数组

Private X() As Double       '结点的x坐标，一位数组，按结点编号顺序存放
Private Y() As Double       '结点的y坐标，一位数组，按结点编号顺序存放
Private XD() As Double       '结点的x坐标，一位数组，按结点编号顺序存放,位移后，XD(J)=X(J)+Al(NDF*(J-1)+1)
Private YD() As Double       '结点的y坐标，一位数组，按结点编号顺序存放,位移后，YD(J)=Y(J)+Al(NDF*(J-1)+2)

'Public isCalculate As Boolean  '是否完成计算
'Public HaveReaded As Boolean   '是否生成结构体

Private PROP() As Double    '各杆件的横截面面积和惯性矩，一维数组，按单元编号顺序存放
Private AL() As Double      '结点荷载或结点位移，一维数组，按结点编号顺序存放
Private TK() As Double      '总刚度矩阵，二维数组，按二维等带宽方式存放
Private ELST() As Double    '单元刚度矩阵，二维数组，存放当前单元的刚度矩阵元素
Private V() As Double       '一维工作数组
Private FORC() As Double    '各单元杆端力，一维数组，按单元编号顺序存放
Private REAC() As Double    '支座预定位移或结点合力，一维数组，按结点编号顺序存放，对于支座结点来说结点合力
                           '即为结点反力；对于自由结点它的值等于相应的结点荷载
                           '计算前为支座预定位移，计算后为支座反力
 

Private Sub Class_Initialize()
    NRMX = 200
    NDF = 2
    NNE = 2
    NDFEL = NDF * NNE
    isCalculate = False
    HaveReaded = False
End Sub

'查询功能
Public Sub GetProperties(Xtemp As Single, Ytemp As Single, statusbar As Object, panel As Object)
    Dim i As Integer, j As Integer, Dis As Double
    For i = 1 To NN
        Dis = Sqr((Xtemp - X(i)) ^ 2 + (Ytemp - Y(i)) ^ 2)
        If Dis < 2 * Unit Then
            If isSearch = True Then
                statusbar.Panels(1).Text = "结点信息"
                statusbar.Panels(2).Text = "坐标：(" + Format(X(i), "0.00") & "," & Format(Y(i), "0.00") & ")  荷载：(" _
                                            & Format(AL1(2 * i - 1), "0.00") & "," & Format(AL1(2 * i), "0.00") & ")"
                If isCalculate = True Then
                    statusbar.Panels(3).Text = "位移量：(" & Format(AL(2 * i - 1), "0.00000") & "," & Format(AL(2 * i), "0.00000") _
                                                & ") 结点力：(" & Format(REAC(2 * i - 1), "0.00") & "," & Format(REAC(2 * i), "0.00") & ")"
                End If
            End If
            Exit Sub
        End If
    Next i
    Dim SD As Integer, ZD As Integer, Xmid As Double, Ymid As Double
    For i = 1 To NE
        SD = NCO(i * 2 - 1)
        ZD = NCO(i * 2)
        Xmid = (X(SD) + X(ZD)) / 2
        Ymid = (Y(SD) + Y(ZD)) / 2
        Dis = Sqr((Xtemp - Xmid) ^ 2 + (Ytemp - Ymid) ^ 2)
        If Dis < 2 * Unit Then
            If isSearch = True Then
                statusbar.Panels(1).Text = "单元信息"
                statusbar.Panels(2).Text = "始点：" + Format(NCO(i * 2 - 1), "00") + " 终点：" + Format(NCO(i * 2), "00") + " 横截面积：" + Format(PROP1(i), "0.0000")
                If isCalculate = True Then
                    statusbar.Panels(3).Text = "轴力：" + Format(PROP1(i), "0.0000")
                End If
            End If
            Exit Sub
        End If
    Next i
End Sub

''数据显示操作
''*********************************************************************************************

'位移数据，显示在panel中
Public Sub GetDis(panel As Object)
    '写结点位移
    If isCalculate = False Then Exit Sub
    
    panel.Text = ""
    Dim i As Integer, K1 As Integer, K2 As Integer, j As Integer
    panel.Text = panel.Text + "NODAL DISPLACEMENTS" + vbCrLf
    panel.Text = "NODE            U               V" + vbCrLf
    For i = 1 To NN
        K1 = NDF * (i - 1) + 1
        K2 = K1 + NDF - 1
        panel.Text = panel.Text + Format(i, "00") + "         "
        For j = K1 To K2
           panel.Text = panel.Text + Format(AL(j), "0.000000") + "     "
        Next j
        panel.Text = panel.Text + vbCrLf
    Next i

End Sub

'取轴力数据，显示在panel中
Public Sub GetForce(panel As Object)

    If isCalculate = False Then Exit Sub
    Dim i As Integer
    panel.Text = ""
    panel.Text = panel.Text + "MEMBER FORCES     MEMBER    AXIAL FORCE" + vbCrLf
    For i = 1 To NE
       panel.Text = panel.Text + Format(i, "00") + "                    " _
                    + Format(FORC(i), "0.000000") + vbCrLf
    Next i
End Sub

'取支座反力，显示在panel中
Public Sub GetREAC(panel As Object)

    If isCalculate = False Then Exit Sub
    Dim i As Integer, K1 As Integer, K2 As Integer, j As Integer
    panel.Text = ""
    panel.Text = panel.Text + "NODAL REACTIONS" + vbCrLf
    panel.Text = panel.Text + "NODE         PX            PY" + vbCrLf
    For i = 1 To NN
        K1 = NDF * (i - 1) + 1
        K2 = K1 + NDF - 1
        panel.Text = panel.Text + Format(i, "00") + "         "
        For j = K1 To K2
            panel.Text = panel.Text + Format(REAC(j), "0.000000") + "        "
        Next j
        panel.Text = panel.Text + vbCrLf
    Next i

End Sub
'***********************************************************************************************

'图形显示操作
'***********************************************************************************************

Public Sub CalScale(panel As Object)
'    Dim Xmin As Double, Xmax As Double, Ymin As Double, Ymax As Double
    Dim i As Integer
    '调整panel的scale
    Xmin = X(1): Xmax = X(1): Ymin = Y(1): Ymax = Y(1)
    For i = 1 To NN
        If X(i) < Xmin Then Xmin = X(i)
        If X(i) > Xmax Then Xmax = X(i)
        If Y(i) < Ymin Then Ymin = Y(i)
        If Y(i) > Ymax Then Ymax = Y(i)
    Next i
    Unit = (Xmax - Xmin) / 100
    xWmin = Xmin - 4 * Unit: xWmax = Xmax + 4 * Unit
    yWmin = Ymin - 4 * Unit: yWmax = Ymax + 4 * Unit
    panel.Scale (xWmin, yWmax)-(xWmax, yWmin)
End Sub

'已知两点坐标画杆件
Private Sub DrawSlgGJ(xs As Double, ys As Double, xz As Double, yz As Double, color As ColorConstants, panel As Object)
    Dim dX As Double, dY As Double, ang As Single, pi As Double
    pi = 3.1415926535
    dX = xz - xs
    dY = yz - ys
    If dX = 0 And dY > 0 Then
        ang = pi / 2
    ElseIf dX = 0 And dY < 0 Then
        ang = pi * 1.5
    Else
        ang = Atn(dY / dX)
        If dX < 0 Then ang = pi + ang
        If dX > 0 And dY <= 0 Then ang = 2 * pi + ang
    End If
    panel.Line (xs + 0.5 * Unit * Cos(ang), ys + 0.5 * Unit * Sin(ang)) _
                -(xz - 0.5 * Unit * Cos(ang), yz - 0.5 * Unit * Sin(ang)), color

End Sub

'已知一点坐标画基座
Private Sub DrawSlgBottom(pX As Double, pY As Double, BX As Integer, BY As Integer, panel As Object, color As ColorConstants)
     Dim i As Integer, Xtemp As Double, Ytemp As Double
     If BY <> 0 Then
        panel.Circle (pX, pY - 2 * Unit * BY), 0.5 * Unit, color
        panel.Line (pX, pY - 0.5 * Unit * BY)-(pX, pY - 1.5 * Unit * BY), color
        panel.Line (pX - 2.5 * Unit, pY - 2 * Unit * BY)-(pX - 0.5 * Unit, pY - 2 * Unit * BY), color
        panel.Line (pX + 2.5 * Unit, pY - 2 * Unit * BY)-(pX + 0.5 * Unit, pY - 2 * Unit * BY), color
        For i = 0 To 10
            If i <> 5 Then
            Xtemp = pX - (2.5 - 0.5 * i) * Unit
            Ytemp = pY - 2 * Unit * BY
            panel.Line (Xtemp, Ytemp)-(Xtemp - 0.25 * Unit, Ytemp - 0.25 * Unit * BY), color
            End If
        Next i
     End If
     If BX <> 0 Then
        panel.Circle (pX - 2 * Unit * BX, pY), 0.5 * Unit, color
        panel.Line (pX - 0.5 * Unit * BX, pY)-(pX - 1.5 * Unit * BX, pY), color
        panel.Line (pX - 2 * Unit * BX, pY - 2.5 * Unit)-(pX - 2 * Unit * BX, pY - 0.5 * Unit), color
        panel.Line (pX - 2 * Unit * BX, pY + 2.5 * Unit)-(pX - 2 * Unit * BX, pY + 0.5 * Unit), color
        For i = 0 To 10
            If i <> 5 Then
                Xtemp = pX - 2 * Unit * BX
                Ytemp = pY - (2.5 - 0.5 * i) * Unit
                panel.Line (Xtemp, Ytemp)-(Xtemp - 0.25 * Unit * BX, Ytemp - 0.25 * Unit), color
            End If
        Next i
     End If
End Sub

'根据读入的数据画位移前杆件，支座
Public Sub DrawConstruct(panel As Object, color As ColorConstants)
    
    If HaveReaded = False Then Exit Sub
    
    Dim i As Integer
    panel.DrawMode = vbCopyPen
    panel.DrawWidth = 1
    panel.Cls
    '画节点
    For i = 1 To NN
        panel.PSet (X(i), Y(i)), color
        panel.Circle (X(i), Y(i)), 0.5 * Unit, color
    Next i
    '画杆件单元
    Dim SD As Integer, ZD As Integer, Xmid As Double, Ymid As Double
    Dim dX As Double, dY As Double, ang As Single
    For i = 1 To NE
        SD = NCO(i * 2 - 1)
        ZD = NCO(i * 2)
        DrawSlgGJ X(SD), Y(SD), X(ZD), Y(ZD), color, panel
    Next i
    
    '根据读入的数据画位移前的支座
    Dim PN As Integer, BX As Integer, BY As Integer
    For i = 1 To NBN
        '对应的结点编号
        PN = IB((NDF + 1) * (i - 1) + 1)
        '判断结点的位移状态，变形方向，以画不同的支座三角形
        BX = IB((NDF + 1) * (i - 1) + 2)
        BY = IB((NDF + 1) * (i - 1) + 3)
        DrawSlgBottom X(PN), Y(PN), BX, BY, panel, color
    Next i
End Sub

'注释节点编号
Public Sub DrawNodeNum(panel As Object, color As ColorConstants)
    If HaveReaded = False Then Exit Sub
    
    Dim i As Integer
    panel.ForeColor = color
    panel.DrawMode = vbXorPen
    For i = 1 To NN
        panel.CurrentX = X(i)
        panel.CurrentY = Y(i)
        panel.Print i
    Next i

End Sub

'注释杆件编号
Public Sub DrawGJnum(panel As Object, color As ColorConstants)
    
    If HaveReaded = False Then Exit Sub
    
    panel.ForeColor = color
    panel.DrawMode = vbCopyPen
    Dim SD As Integer, ZD As Integer, Xmid As Double, Ymid As Double, i As Integer

    For i = 1 To NE
        SD = NCO(i * 2 - 1)
        ZD = NCO(i * 2)
        '杆件中点处标注杆件编号
        Xmid = (X(SD) + X(ZD)) / 2
        Ymid = (Y(SD) + Y(ZD)) / 2
        panel.CurrentX = Xmid
        panel.CurrentY = Ymid
        panel.Print i
    Next i

End Sub

'计算位移后的结点坐标
Public Sub GetXYDis(K As Double, scale1 As Double)
    Dim i As Integer
    ReDim XD(NN) As Double
    ReDim YD(NN) As Double
    For i = 1 To NN
        XD(i) = X(i) + AL(NDF * (i - 1) + 1) * scale1 * K
        YD(i) = Y(i) + AL(NDF * (i - 1) + 2) * scale1 * K
    Next i
End Sub

'画位移后的杆件,支座
Public Sub DrawConstructDis(panel As Object, color As ColorConstants)