'平法梁编号前移或后移动
Sub Add_BeamIndex()
    Dim ssText As AcadSelectionSet
    Set ssText = CreateSelectionSet
    '定义过滤机制
    Dim filterType() As Integer
    Dim filterData() As Variant
    ReDim filterType(0)
    ReDim filterData(0)
    filterType(0) = 0
    filterData(0) = "TEXT"
    
    Dim L As String
    Dim LM As String '梁的名称,比如KL LL DLL WKL等
    Dim LH As Integer '梁的编号
    
    '提示用户在屏幕上选择文字
    Prompt "选择你要前移或向后移动的第一个平法梁标注:"
    ssText.SelectOnScreen filterType, filterData
    Dim I As Integer, J As Integer, N As Integer
    Dim Temp As Integer
    Dim T As AcadText
    For I = 0 To ssText.Count - 1
        Set T = ssText.item(I)
        L = T.textString
        Temp = InStr(L, "x")
        If Temp > 0 Then Exit For
    Next I

    LH = CVal(L, I)
    LM = Left(L, I - 1)

    Dim Result As Integer
    Dim A  As Integer
    A = InputBox("输入你要增加的平法梁个数!负数编号前移(减少),正数编号后移(增加)", "田草CAD工具箱")
    If A <> 0 Then
        ssText.Clear
        Prompt "选择你要更改的所以平法梁标注:"
        ssText.SelectOnScreen filterType, filterData
        For Each T In ssText
            L = T.textString
            If InStr(L, LM) > 0 Then
               N = CVal(L, Temp)
               If N >= LH And LH + A > 0 Then 'lH+A>0 是为了防止编号不够前移的。
                    L = Replace(L, Trim(str(N)) & "(", Trim(str(N + A)) & "(")
                    T.textString = L
                    T.Update
               End If
            End If
        Next
    End If
End Sub
'删除平法梁，后面的梁序号自动排
Sub Del_BeamIndex()
    Dim ssText As AcadSelectionSet
    Set ssText = CreateSelectionSet
    '定义过滤机制
    Dim filterType() As Integer
    Dim filterData() As Variant
    ReDim filterType(0)
    ReDim filterData(0)
    filterType(0) = 0
    filterData(0) = "TEXT"
    
    Dim L As String
    Dim LM As String '梁的名称,比如KL LL DLL WKL等
    Dim LH As Integer '梁的编号
    
    '提示用户在屏幕上选择文字
    Prompt "选择你要删除一根梁的平法标注:"
    ssText.SelectOnScreen filterType, filterData
    Dim I As Integer, J As Integer, N As Integer
    Dim Temp As Integer
    Dim T As AcadText
    For I = 0 To ssText.Count - 1
        Set T = ssText.item(I)
        L = T.textString
        Temp = InStr(L, "x")
        If Temp > 0 Then Exit For
    Next I

    LH = CVal(L, I)
    LM = Left(L, I - 1)

    Dim Result As Integer
    Dim MSG As String
    MSG = "是否确定要删除" & L & "梁?删除后，后面的梁序号将被重排."
    Result = MsgBox(MSG, vbOKCancel, "田草CAD工具箱")
    If Result = 1 Then
        For I = 0 To ssText.Count - 1
            ssText.item(I).Delete
        Next
        ssText.Clear
        Prompt "选择你要更改的所以平法梁标注:"
        ssText.SelectOnScreen filterType, filterData
        For Each T In ssText
            L = T.textString
            If InStr(L, LM) > 0 Then
               N = CVal(L, Temp)
               If N > LH Then
                    L = Replace(L, Trim(str(N)) & "(", Trim(str(N - 1)) & "(")
                    T.textString = L
                    T.Update
               End If
            End If
        Next
    End If
End Sub
'返回字符串中第一个数值，和在字符串中的位置
Function CVal(s As String, ByRef I As Integer) As Double
    Dim N As Integer, M As Integer
    Dim Temp As Integer
    Dim Temp_Str As String
    Temp = 0
    For N = 1 To Len(s)
        Temp_Str = Mid(s, N, 1)
        If IsNumeric(Temp_Str) = True And Temp = 0 Then
            Temp = 1
            I = N
        ElseIf Temp = 1 And IsNumeric(Temp_Str) = False And Temp_Str <> "." Then
            M = N
            Exit For
        End If
    Next N
    If M = 0 Then M = N
    CVal = Val(Mid(s, I, M - I + 1))
End Function