mdlgraphic.bas

来自「用visual basic编写的有限元程序！」· BAS 代码 · 共 72 行

Attribute VB_Name = "mdlGraphic"
Public Const MINVALUE = 0.00000001

Function AdjustGraph()
    Dim I&, MinX!, MinY!, MaxX!, MaxY!
    MinX = Nodes(1).Point(0): MaxX = Nodes(1).Point(0)
    MinY = Nodes(1).Point(1): MaxY = Nodes(1).Point(1)
    For I = 1 To Top_Node
        If MinX > Nodes(I).Point(0) Then MinX = Nodes(I).Point(0)
        If MaxX < Nodes(I).Point(0) Then MaxX = Nodes(I).Point(0)
        If MinY > Nodes(I).Point(1) Then MinY = Nodes(I).Point(1)
        If MaxY < Nodes(I).Point(1) Then MaxY = Nodes(I).Point(1)
    Next
    Call frmANS.AdjGraphScale(MinX, MaxX, MinY, MaxY)
End Function
Function PlotAll()
    Dim I&
    
    Dim Pi#(2), Pj#(2), Pk#(2)
    For I = 1 To Top_Elem
        Call CopyPoint(Pi, Nodes(Elems(I).Nodes(1)).Point)
        Call CopyPoint(Pj, Nodes(Elems(I).Nodes(2)).Point)
        Call CopyPoint(Pk, Nodes(Elems(I).Nodes(3)).Point)
        frmANS.AddLine vbWhite, Pi, Pj, Pk, Pi
    Next
    For S = 1 To Top_Node
        If bBit(Nodes(S).U_Code, CN_X) Then
            frmANS.AddDofs Nodes(S).Point, Nodes(S).Theta(0)
        End If
        If bBit(Nodes(S).U_Code, CN_Y) Then
            frmANS.AddDofs Nodes(S).Point, Nodes(S).Theta(0) + Dtr(90)
        End If
        If bBit(Nodes(S).F_Code, CN_X) Then
            frmANS.AddForce Nodes(S).Point, 0, Nodes(S).F(0)
        End If
        If bBit(Nodes(S).F_Code, CN_Y) Then
            frmANS.AddForce Nodes(S).Point, 2 * Atn(1), Nodes(S).F(1)
        End If
    Next
End Function

Function PlotDof()
    Dim Pi#(2), Pj#(2), Pk#(2), Pnt#(2)
    Dim I&, J&, K&, N&
    Dim Angle1#, Value1#
    For N = 1 To Top_Elem
        I = Elems(N).Nodes(1)
        J = Elems(N).Nodes(2)
        K = Elems(N).Nodes(3)
        Call NXYZ(Pi, I, 1)
        Call NXYZ(Pj, J, 1)
        Call NXYZ(Pk, K, 1)
        frmANS.AddLine vbYellow, Pi, Pj, Pk, Pi
    Next
    For N = 1 To Top_Node
        Pnt(0) = NX(N) + UX(N): Pnt(1) = NY(N) + UY(N)
        If bBit(Nodes(N).U_Code, CN_X) Then
            frmANS.AddDofs Pnt, Nodes(N).Theta(0)
        End If
        If bBit(Nodes(N).U_Code, CN_Y) Then
            frmANS.AddDofs Pnt, Nodes(N).Theta(0) + Dtr(90)
        End If
        If (Abs(Node2s(N).R(0)) > MINVALUE) Or (Abs(Node2s(N).R(1)) > MINVALUE) Then
            Angle1 = Atan(Node2s(N).R(1), Node2s(N).R(0))
            Value1 = Sqr(Node2s(N).R(0) ^ 2 + Node2s(N).R(1) ^ 2)
            frmANS.AddReaction Pnt, Angle1, Value1
        End If
    Next
End Function