'分析梁平法标注
Sub GetLPF()
    Dim ssText As AcadSelectionSet          '选择集
    Dim acText As AcadText                  '选择集中的文本
    
    Dim Txt As String '文本的字符串
    
    Dim x As Integer '字符串中是否含有乘号
    Dim a As Integer '字符串中是否含有@符号
    Dim Temp As Integer
    Dim Temp1 As Integer
    Dim Temp2 As String
    Dim Temp3 As String
    Dim Temp4 As String
    Dim LLX As String
    Dim LB As Integer
    Dim LG As Integer
    Dim LK As Integer
    Dim GJZJ As Integer
    Dim GJJB As Integer
    Dim GJZS As Integer
    Dim GJJMQ As Integer
    Dim GJFJMQ As Integer
    Dim N1 As Integer
    Dim N2 As Integer
    Dim N3 As Integer
    Dim N4 As Long
    Dim G1 As Integer
    Dim G2 As Integer
    Dim G3 As Integer
    Dim G4 As Long
    Dim BG As Double
    Dim AT As Long
    Dim AB As Long
    On Error Resume Next
    
    Set ssText = ThisDrawing.SelectionSets.Add("Text")
    '定义过滤机制
    Dim filterType(0) As Integer
    Dim filterData(0) As Variant
    filterType(0) = 0
    filterData(0) = "TEXT"
    '提示用户在屏幕上选择文字
    ssText.SelectOnScreen filterType, filterData
    n = ssText.Count - 1
    For i = 0 To n
        Set acText = ssText.item(i)
        Txt = acText.textString
        x = InStr(Txt, "x") '标志他是平法标注的第一行
        a = InStr(Txt, "@") ' 平法标注的第二行
        Temp2 = Left(Txt, 1)
        'MsgBox X
        If x > 0 Then
           Temp = InStr(Txt, "(")
           Temp1 = InStr(Txt, ")")
           LLX = Left(Txt, Temp - 1)
           MsgBox LLX
           Select Case LLX
           Case "KL"
                MsgBox "框架梁"
           Case "LL"
                MsgBox "连梁"
           Case "L"
                MsgBox "梁"
           Case "KZL"
                MsgBox "框支梁"
           Case "WKL"
                MsgBox "屋面框架梁"
           Case "QZL"
                MsgBox "墙支梁"
           Case "JZL"
                MsgBox "井字梁"
           Case "XL"
                MsgBox "悬挑梁"
           End Select
           
           LB = Val(Mid(Txt, Temp1 + 1, x - Temp1))
           MsgBox "梁宽" & LB
           LG = Val(Mid(Txt, x + 1))
           MsgBox "梁高" & LG '
            If Mid(Txt, Temp1 - 1, 1) = "A" Then
                LK = Mid(Txt, Temp + 1, Temp1 - Temp - 2)
                MsgBox LK & "跨一端悬挑"
            ElseIf Mid(Txt, Temp1 - 1, 1) = "B" Then
                LK = Mid(Txt, Temp + 1, Temp1 - Temp - 2)
                MsgBox LK & "跨二端悬挑"
            Else
                LK = Mid(Txt, Temp + 1, Temp1 - Temp - 1)
                MsgBox LK & "跨"
            End If
        End If
        If a > 0 Then
           GJZJ = Val(Mid(Txt, 6, a - 6))
           MsgBox "箍筋直径" & GJZJ
           If Mid(Txt, 3, 3) = "130" Then
            GJJB = 1
           ElseIf Mid(Txt, 3, 3) = "131" Then
            GJJB = 2
           ElseIf Mid(Txt, 3, 3) = "132" Then
            GJJB = 3
           End If
           MsgBox "箍筋级别" & GJJB
           Temp = InStr(Txt, "(")
           Temp1 = InStr(Txt, "/")
           
           If Temp = 0 Then
              GJZS = 2
              If Temp1 <> 0 Then
                 GJJMQ = Val(Mid(Txt, a + 1, Temp1 - a))
                 GJFJMQ = Val(Mid(Txt, Temp1 + 1))
              Else
                 GJJMQ = Val(Mid(Txt, a + 1))
                 GJFJMQ = GJJMQ
              End If
           Else
              GJZS = Val(Right(Txt, 2))
              If Temp1 <> 0 Then
                 GJJMQ = Val(Mid(Txt, a + 1, Temp1 - a))
                 GJFJMQ = Val(Mid(Txt, Temp1 + 1, Temp - Temp1 - 1))
              Else
                 GJJMQ = Val(Mid(Txt, a + 1, Temp - a - 1))
                 GJFJMQ = GJJMQ
              End If
           End If
           MsgBox "箍筋肢数" & GJZS
           MsgBox "箍筋加密区" & GJJMQ
           MsgBox "箍筋非加密器" & GJFJMQ
        End If
        If Temp2 = "N" Then '受扭钢筋
           Txt = Right(Txt, Len(Txt) - 1)
           GetSteels Txt, N1, N2, N3, N4
           MsgBox "抗扭钢筋根数" & N1
           MsgBox "抗扭钢筋级别" & N2
           MsgBox "抗扭钢筋直径" & N3
           MsgBox "抗扭钢筋面积" & N4
        ElseIf Temp2 = "G" Then '腰筋
           Txt = Right(Txt, Len(Txt) - 1)
           GetSteels Txt, G1, G2, G3, G4
           MsgBox "构造纵筋根数" & G1
           MsgBox "构造纵筋级别" & G2
           MsgBox "构造纵筋直径" & G3
           MsgBox "构造纵筋面积" & G4
        ElseIf Temp2 = "(" Then '标高
           Txt = Right(Txt, Len(Txt) - 1)
           BG = Val(Txt)
           MsgBox "梁的相当标高" & BG
        Else '梁纵筋
           If x = 0 And a = 0 Then
                Temp = InStr(Txt, ";")
                If Temp > 0 Then
                    Temp3 = Left(Txt, Temp - 1)
                    Temp4 = Mid(Txt, Temp + 1)
                    Do
                       Temp1 = InStr(Temp3, "%")
                       If Temp1 = 0 Then Exit Do
                       AT = Int(Val(Mid(Temp3, Temp1 - 1, 1)) * Val(Mid(Temp3, Temp1 + 5, 2)) ^ 2) * 3.14 / 4 + AT
                       Temp3 = Mid(Temp3, Temp1 + 8)
                    Loop
                    MsgBox "上部钢筋面积" & AT
                    Do
                       Temp1 = InStr(Temp4, "%")
                       If Temp1 = 0 Then Exit Do
                       AB = Int(Val(Mid(Temp4, Temp1 - 1, 1)) * Val(Mid(Temp4, Temp1 + 5, 2)) ^ 2) * 3.14 / 4 + AB
                       Temp4 = Mid(Temp4, Temp1 + 8)
                    Loop
                    MsgBox "下部钢筋面积" & AB
                 Else
                    Temp3 = Txt
                    Do
                       Temp1 = InStr(Temp3, "%")
                       If Temp1 = 0 Then Exit Do
                       AT = Int(Val(Mid(Temp3, Temp1 - 1, 1)) * Val(Mid(Temp3, Temp1 + 5, 2)) ^ 2) * 3.14 / 4 + AT
                       Temp3 = Mid(Temp3, Temp1 + 8)
                    Loop
                    MsgBox "上部钢筋面积" & AT
                 End If
            End If
        End If
    Next i
        '删除选择集
    ThisDrawing.SelectionSets.item("Text").Delete
End Sub