mdlio.bas

用visual basic编写的有限元程序！

Attribute VB_Name = "mdlIO"
Public Function ReadApdl(ByVal sPath As String, ByVal sName As String, ByVal sExt As String) As Long
    Dim InputLine As String, nfil As Integer
    Dim ARG(10) As String
    Dim I As Integer, J As Integer
    Dim Top_KeyPnt%, Top_KeyLin%, Top_KeyArea%
    
    ReadApdl = -1
    ClearAll  '清除内存
    
    If Right(sPath, 1) <> "\" Then sPath = sPath + "\"
    '保存节点文件
    FullFileName = sPath + sName + "." + sExt
    If Dir(FullFileName) = "" Then MsgBox "文件没找到!", vbCritical: Exit Function
    nfil = FreeFile
    Open FullFileName For Input As #nfil
    
    '读入所有命令
    Do While Not EOF(nfil)
        Line Input #nfil, InputLine
        InputLine = UCase(Trim(InputLine))
        
        If InputLine = "" Then               '空行
        ElseIf Left(InputLine, 1) = "!" Then '注释语句
        Else                                 '命令行
            InputLine = Trim(FirstWord(InputLine, "!"))
            For I = 0 To 10
                If InputLine = "" Then
                    ARG(I) = 0
                Else
                    ARG(I) = FirstWord(InputLine, ",")
                End If
            Next
            Do_APDL ARG
        End If
    Loop
    Close #nfil
    ReadApdl = 0
End Function

Public Function SaveDofs(ByVal sPath As String, ByVal sName As String, ByVal sExt As String) As Long
    Dim Ni&, nfil%, OutputLine$
    Dim fScl#: fScl = 1 'XXX
    If Right(sPath, 1) <> "\" Then sPath = sPath + "\"
    FullFileName = sPath + sName + "." + sExt
    nfil = FreeFile
    Open FullFileName For Output As #nfil
    For Ni = 1 To Top_Node
        If True Then
            OutputLine = FmtA(Ni, "I6") _
                       & FmtA(fScl * Node2s(Ni).U(0), "G20.13") _
                       & FmtA(fScl * Node2s(Ni).U(1), "G20.13")
            Print #nfil, OutputLine
        End If
    Next
    Close #nfil
End Function