'平法梁配筋率分析
Sub GetLPJL()
    Dim ssText As AcadSelectionSet          '选择集
    Dim acText As AcadText                  '选择集中的文本
    
    Dim Txt As String '文本的字符串
    
    Dim X As Integer '字符串中是否含有乘号
    Dim Temp As Integer
    Dim Temp1 As Integer
    Dim Temp2 As String
    Dim Temp3 As String
    Dim Temp4 As String
    Dim LK As Integer
    Dim LG As Integer
    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") '标志他是平法标注的第一行
        Temp2 = Left(Txt, 1)
        'MsgBox X
        If X > 0 Then
           Temp = InStr(Txt, "(")
           Temp1 = InStr(Txt, ")")
           
           LK = Val(Mid(Txt, Temp1 + 1, X - Temp1))
           'MsgBox "梁宽" & LK
           LG = Val(Mid(Txt, X + 1))
           'MsgBox "梁高" & LG '
        End If
        If IsNumeric(Temp2) Then
                Temp = InStr(Txt, ";")
                If Temp > 0 Then
                    Temp3 = Left(Txt, Temp - 1)
                    Temp4 = Mid(Txt, Temp + 1)
                    AT = GetSteels2(Temp3)
                    AB = GetSteels2(Temp4)
                Else
                Temp3 = Txt
                '这里设置i=1 和i=2的意思是，如果先选择L截面，然后选支座钢筋，最后选择下部钢筋
                If i = 1 Then
                    AT = GetSteels2(Temp3)
                ElseIf i = 2 Then
                    AB = GetSteels2(Temp3)
                End If
            End If
        End If
    Next i
    MsgBox "上部钢筋面积" & AT
    MsgBox "上部钢筋配筋率" & Format(AT / LK / LG * 100, "0.0000")
    MsgBox "下部钢筋面积" & AB
    MsgBox "下部钢筋配筋率" & Format(AB / LK / LG * 100, "0.0000")
    MsgBox "上下钢筋面积比" & Format(AT / AB, "0.00")
    Dim P As Variant
    P = ThisDrawing.Utility.GetPoint(, "文字插入点")
    Dim S(4) As String
    S(0) = "上部钢筋面积" & AT
    S(1) = "上部钢筋配筋率" & Format(AT / LK / LG * 100, "0.0000")
    S(2) = "下部钢筋面积" & AB
    S(3) = "下部钢筋配筋率" & Format(AB / LK / LG * 100, "0.0000")
    S(4) = "上下钢筋面积比" & Format(AT / AB, "0.00")
    AddTexts S, P, 300
        '删除选择集
    ThisDrawing.SelectionSets.item("Text").Delete
End Sub
'字符串数组，添加到CAD中
Function AddTexts(T() As String, P As Variant, H As Long)
    Dim G As AcadGroup
    Dim GN As String
    GN = NiMingZu("Texts")
    Set G = ThisDrawing.Groups.Add(GN)
    Dim i As Integer
    Dim Objs() As AcadEntity
    ReDim Objs(UBound(T) - 1)
    For i = 0 To UBound(T) - 1
        P(1) = P(1) - H * 1.5
        Set Objs(i) = ThisDrawing.ModelSpace.AddText(T(i), P, H)
    Next i
    G.AppendItems Objs
End Function