constructcls.cls

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

    
    If isCalculate = False Then Exit Sub
    panel.DrawMode = vbCopyPen
    '画节点
    Dim i As Integer, SD As Integer, ZD As Integer
    For i = 1 To NN
        panel.PSet (XD(i), YD(i)), color
        panel.Circle (XD(i), YD(i)), Unit * 0.5, color
    Next i
    '画杆件单元
    For i = 1 To NE
        SD = NCO(i * 2 - 1)
        ZD = NCO(i * 2)
        DrawSlgGJ XD(SD), YD(SD), XD(ZD), YD(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 XD(PN), YD(PN), BX, BY, panel, color
    Next i
End Sub

'结构渐变动画
Public Sub StructMove(panel As Object, K As Double, color As ColorConstants)
    GetXYDis K, scale1
    DrawConstructDis panel, color
End Sub

'注释轴力大小
Public Sub DrawForceMag(panel As Object, color As ColorConstants)
    If isCalculate = 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 Format(FORC(i), "0.###")
    Next i
    
End Sub

'画轴力，轴力越大，矩形高度越大
Public Sub DrawForce(panel As Object, color As ColorConstants)
    If isCalculate = False Then Exit Sub
    panel.DrawMode = vbCopyPen
    panel.DrawWidth = 1
    Dim i As Integer, SD As Integer, ZD As Integer
    Dim xs As Double, ys As Double, xz As Double, yz As Double, Height As Double, Pmax As Double
    Pmax = 0
    For i = 1 To NE
        If Pmax < Abs(FORC(i)) Then Pmax = Abs(FORC(i))
    Next i
    
    Dim a As Double
    For i = 1 To NE
        SD = NCO(i * 2 - 1)
        ZD = NCO(i * 2)
        If X(SD) = X(ZD) Then
            a = -3.1415926 / 2
        Else
            a = Atn((Y(ZD) - Y(SD)) / (X(ZD) - X(SD)))
        End If
        a = a + 3.1415926 / 2
        Height = Abs(FORC(i)) / Pmax * Unit * 8
        xs = X(SD) + Height * Cos(a)
        ys = Y(SD) + Height * Sin(a)
        xz = X(ZD) + Height * Cos(a)
        yz = Y(ZD) + Height * Sin(a)
        panel.Line (xs, ys)-(X(SD), Y(SD)), color
        panel.Line (X(ZD), Y(ZD))-(xz, yz), color
        panel.Line (xs, ys)-(xz, yz), color
    Next i
End Sub
'****************************************************************************************************

'实时数据输入操作
'********************************************************************************************

'通过窗口输入，传递参数赋值
Public Sub SetData()
    If NN1 = 0 Or NE1 = 0 Or NBN1 = 0 Or E1 = 0 Then
        MsgBox "数据有误"
        Exit Sub
    End If
    X = X1          '结点的x坐标，一位数组，按结点编号顺序存放
    Y = Y1          '结点的y坐标，一位数组，按结点编号顺序存放
    NN = NN1        '结点总数
    N = N1
    NE = NE1        '单元总数
    NBN = NBN1      '支座结点总数
    E = E1
    AL = AL1        '结点荷载或结点位移，一维数组，按结点编号顺序存放
    NLN = NLN1      '受荷载的结点总数
    NCO = NCO1      '各单元两端的结点号，一维数组，按单元编号顺序存放
    PROP = PROP1    '各杆件的横截面面积和惯性矩，一维数组，按单元编号顺序存放
    IB = IB1        '支座结点的位移状态，一位数组
    REAC = REAC1     '支座预定位移或结点合力，一维数组，按结点编号顺序存放，对于支座结点来说结点合力
                           '即为结点反力；对于自由结点它的值等于相应的结点荷载
                           '计算前为支座预定位移，计算后为支座反力
    HaveReaded = True
End Sub

Public Sub SetDataShow()
    ReDim X1(NN) As Double
    ReDim Y1(NN) As Double
    ReDim PROP1(NE) As Double
    ReDim NCO1(NNE * NE)
    ReDim AL1(N) As Double
    ReDim REAC1(N) As Double
    ReDim IB1((NDF + 1) * NBN) As Integer

    NN1 = NN       '结点总数
    NE1 = NE       '单元总数
    N1 = N
    NLN1 = NLN     '受荷载的结点总数
    NBN1 = NBN      '支座结点总数
    E1 = E
    AL1 = AL        '结点荷载或结点位移，一维数组，按结点编号顺序存放
    X1 = X         '结点的x坐标，一位数组，按结点编号顺序存放
    Y1 = Y         '结点的y坐标，一位数组，按结点编号顺序存放
    NCO1 = NCO      '各单元两端的结点号，一维数组，按单元编号顺序存放
    PROP1 = PROP    '各杆件的横截面面积和惯性矩，一维数组，按单元编号顺序存放
    IB1 = IB        '支座结点的位移状态，一位数组
    REAC1 = REAC     '支座预定位移或结点合力，一维数组，按结点编号顺序存放，对于支座结点来说结点合力
                           '即为结点反力；对于自由结点它的值等于相应的结点荷载
                           '计算前为支座预定位移，计算后为支座反力
    HaveReaded = True
    IsAddedNode = True ' 是否添加过数据的识别
    IsAddedBase = True
    IsAddedGanJian = True
    IsAddedPara = True
End Sub

'**************************************************************************************

'通过文件输入数据
'*****************************************************************************************
 ' INPUT PROGRAM
 '读入数据
Public Sub InputData(filename As String)
    Dim i As Integer, NUM As Integer, N1 As Integer, IC(1) As Integer, K As Integer, _
     L As Integer, L1 As Integer, L2 As Integer, N2 As Integer
    Dim W(2) As Double
    Dim fp As Integer  ' 打开文件号
    fp = FreeFile
    Open filename For Input As #fp
    '(1)读进基本参数
    Input #fp, NN
    Input #fp, NE
    Input #fp, NLN
    Input #fp, NBN
    Input #fp, E
    If E > 0 Then IsAddedPara = True
    '(2)读进结点的编号，坐标
    If NN > 0 Then
        IsAddedNode = True
        ReDim X(NN) As Double
        ReDim Y(NN) As Double
        N = NN * NDF
        ReDim AL(N) As Double
        ReDim REAC(N) As Double
        For i = 1 To NN
            Input #fp, NUM
            Input #fp, X(i)
            Input #fp, Y(i)
        Next i
    End If
    '(3)读进单元两端的结点号和截面特征
    If NE > 0 Then
        IsAddedGanJian = True
        ReDim PROP(NE) As Double
        ReDim NCO(NNE * NE)
    '    ReDim PROP1(NE) As Double
    '    ReDim NCO1(NNE * NE)
        For i = 1 To NE
            N1 = NNE * (i - 1)
            Input #fp, NUM
            Input #fp, IC(0)
            Input #fp, IC(1)
            Input #fp, PROP(i)
            NCO(N1 + 1) = IC(0)
            NCO(N1 + 2) = IC(1)
        Next i
    End If
    ' COMPUTE ACTUAL NUMBER OF UNKNOWNS AND CLEAR THE LOAD VECTOR
    ' READ THE NODAL LOADS AND STORE THEM IN ARRAY AL
    '(4)读进结点荷载
    If NLN > 0 Then
        For i = 1 To NLN
            Input #fp, NUM
            Input #fp, W(0)
            Input #fp, W(1)
            For K = 1 To NDF
                L = NDF * (NUM - 1) + K
                AL(L) = W(K - 1)
            Next K
        Next
    End If
' READ BOUNDARY NODES DATA. STORE UNKNOWN STATUS INDICATORS
' IN ARRAY IB, AND PRESCRIBED UNKNOWN VALUES IN ARRAY REAC
    '(5)读进支座约束信息
    If NBN > 0 Then
        IsAddedBase = True
        ReDim IB((NDF + 1) * NBN) As Integer
        For i = 1 To NBN
            Input #fp, NUM
            Input #fp, IC(0)
            Input #fp, IC(1)
            Input #fp, W(0)
            Input #fp, W(1)
            L1 = (NDF + 1) * (i - 1) + 1
            L2 = NDF * (NUM - 1)
            IB(L1) = NUM
            For K = 1 To NDF
                N1 = L1 + K
                N2 = L2 + K
                IB(N1) = IC(K - 1)
                REAC(N2) = W(K - 1)
            Next K
        Next i
    End If
    Close #fp
    If IsAddedPara = True And IsAddedNode = True And IsAddedBase = True And IsAddedGanJian = True Then
        HaveReaded = True
    End If
    SetDataShow
End Sub

Public Sub OUTPUTknowData(filename As String)
    Dim i As Integer, K1 As Integer, K2 As Integer, j As Integer
    Dim fp As Integer  ' 打开文件号
    fp = FreeFile
    Open filename For Output As #fp
    '写文件头
    Print #fp, " **********************************************************************"
    Print #fp, ""
    Print #fp, ""
    Print #fp, ""
    Print #fp, "INTERNAL DATA"
    Print #fp, ""
    Print #fp, "NUMBER OF NODES          :     "; NN
    Print #fp, "NUMBER OF ELEMENTS       :     "; NE
    Print #fp, "NUMBER OF LOADED NODES   :     "; NLN
    Print #fp, "NUMBER OF SUPPORT NODES  :     "; NBN
    Print #fp, "MODULUS OF ELASTICITY    :     "; E
    Print #fp, ""
    NN1 = NN
    NE1 = NE
    NLN1 = NLN
    NBN1 = NBN
    E1 = E
    
    '写结点坐标
    ' WRITE NODAL COORDINATES IN ARRAY X AND Y
    Print #fp, "NODAL COORDINATES"
    Print #fp, "       NODE"; "      X"; "        Y"
    For i = 1 To NN
        Print #fp, Tab(9); Format(i, "00"); Tab(18); X(i); Tab(27); Y(i)
    Next i
    Print #fp, ""
    'WRITE ELEMENT CONNECTIVITY IN ARRAY NCO AND ELEMENT PROPERTIES IN ARRAY PROP
    Print #fp, " ELEMENT CONNECTIVITY AND PROPERTIES"
    Print #fp, "    ELEMENT    START NODE    END NODE     AREA"
    For i = 1 To NE
        Print #fp, Tab(6); Format(i, "00"); Tab(20); NCO(i * 2 - 1); Tab(33); NCO(i * 2); Tab(43); PROP(i)
    Next i
    Print #fp, ""
    'READ THE NODAL LOADS AND STORE THEM IN ARRAY AL
    Print #fp, " NODAL LOADS"
    Print #fp, "       NODE     PX        PY"
    For i = 1 To NN
        If AL(2 * i - 1) <> 0 Or AL(2 * i) <> 0 Then
            Print #fp, Tab(9); Format(i, "00"); Tab(17); AL(2 * i - 1); Tab(27); AL(2 * i)
        End If
    Next i
    Print #fp, ""
    'READ BOUNDARY NODES DATA. STORE UNKNOWN STATUS INDICATORS IN ARRAY IB, AND PRESCRIBED UNKNOWN VALUES IN ARRAY REAC
    Print #fp, " BOUNDARY CONDITION DATA"
    Print #fp, "                       STATUS             PRESCRIBED VALUES"
    Print #fp, "              (0:PRESCRIBED, 1:FREE)"
    Print #fp, "      NODE        U         V                U         V"
    For i = 1 To NBN
        Print #fp, Tab(10); IB((NDF + 1) * (i - 1) + 1); Tab(20); IB((NDF + 1) * (i - 1) + 2); Tab(30); _
             IB((NDF + 1) * (i - 1) + 3); Tab(46); REAC(NDF * i - 1); Tab(56); REAC(NDF * i)
    Next i
    Close #fp
    
End Sub

Public Sub OUTPUTresult(filename As String)
    Dim i As Integer, K1 As Integer, K2 As Integer, j As Integer
    Dim fp As Integer  ' 打开文件号
    fp = FreeFile
    Open filename For Append As #fp
    Print #fp, " **********************************************************************"
    Print #fp, ""
    Print #fp, ""
    Print #fp, "RESULTS"
    Print #fp, ""
    Print #fp, ""