适用于提取cad图纸里的文本，并进行排序（针对整型数据）。按区间分类，并自动复制到剪贴板中。可适当修改，提高工作效率。

步骤及效果：
1、运行vba宏，框选数字文本框


2、空格继续执行后，宏会自动排序并复制到剪贴板中。在excel中粘贴的内容如下图，第一格为排
序好后的数字区间及组合，第二个为cad选框选中文本的总数。



VBA代码如下：
_____________________________________________________________________
    Private Type mystr
        str As String
        x As Double
        y As Double
End Type

 Sub TQ()

    On Error Resume Next

    Dim i As Integer
    Dim j As Integer
     Dim m As Integer
     Dim step As Integer
    Dim E As Excel.Application, B As Workbook, S As Worksheet
    Dim SS As AcadSelectionSet, T As Object, FT(3) As Integer, FD(3) As Variant
    Dim search As String
    Dim mstrcount As Integer
    Dim lengthstr As Integer
    Dim block(0 To 50) As Integer
    Dim seltext(0 To 255) As mystr
    Dim counter As Integer
    'Dim midnum As Double
    Dim midstr As mystr
    search = "\pt1;"

    '下面定义选择集过滤器列表为多行文字或单行文字

    FT(0) = -4: FD(0) = "<or"

    FT(1) = 0: FD(1) = "mtext"

    FT(2) = 0: FD(2) = "text"

    FT(3) = -4: FD(3) = "or>"

    '创建选择集

    Set SS = ThisDrawing.SelectionSets.Add("SS")

    '在屏幕上选择多行文字或单行文字对象"

    SS.SelectOnScreen FT, FD

    '如果选择集不为空则运行以下代码

    If SS.Count > 0 Then

        '运行EXCEL程序

        Set E = New Excel.Application

        '在EXCEL中插入工作薄

        Set B = E.Workbooks.Add

        Set S = B.ActiveSheet

        '设置一列宽度

        S.Columns(1).ColumnWidth = 30

        '显示EXCEL程序

        E.Visible = False

        '把所有字符串及坐标保存起来

        For Each T In SS

            seltext(i).str = T.TextString

            i = i + 1
        Next
        counter = i - 1
         
          '把单行文字或多行文字的内容写入表格

        '对于多行文字，如果直接写入则字符串中很可能包含转义符，使用者可根据需要对字符串运算处理后再写入表格

        For i = 0 To counter

             mstrcount = InStr(1, seltext(i).str, search) '判断是否为多行文字

             If mstrcount > 0 Then

             lengthstr = Len(seltext(i).str)

             '去除多行文字前面多余的部分

             seltext(i).str = Right(seltext(i).str, lengthstr - 5)

             End If

             S.Cells(i + 1, 1).Value = seltext(i).str
        Next i
         
            
        'sort ， 放在excel中排序可以简单解决string和integer排序的次序问题,但排序速度慢
        For i = 1 To counter
            
            For j = i + 1 To counter + 1
                
                If S.Cells(i, 1) > S.Cells(j, 1) Then
                
                'If CInt(Val(seltext(i).str)) > CInt(Val(seltext(j).str)) Then
                
                    S.Cells(1, 2) = S.Cells(i, 1)
                    S.Cells(i, 1) = S.Cells(j, 1)
                    S.Cells(j, 1) = S.Cells(1, 2)
                 End If
            Next j
            
        Next i
        
        '区间组合，判断整数连续区间，可做适当修改
         
       m = 1
       j = 1
       For i = 1 To counter + 1
            step = 1
                
            For j = i + 1 To counter + 2
            
                If CInt(Val(S.Cells(i, 1))) + step = CInt(Val(S.Cells(j, 1))) And Len(S.Cells(i, 1)) = Len(S.Cells(j, 1)) Then
                    step = step + 1
                Else
                    S.Cells(m, 3) = S.Cells(i, 1)
                        If j - i <> 1 Then
                        S.Cells(m, 4) = S.Cells(j - 1, 1)
                        End If
                    m = m + 1
                    Exit For
                 End If
            Next j
            
            i = j - 1
            
        Next i
        
        '为区间范围添加“-”连接符
        For i = 1 To m - 1
            If Len(S.Cells(i, 4)) <> 0 Then
            S.Cells(i, 5).Value = S.Cells(i, 3).Value & "-" & S.Cells(i, 4).Value
            Else
            S.Cells(i, 5).Value = S.Cells(i, 3).Value
            End If
        Next i
             
        S.Cells(1, 6).Value = S.Cells(1, 5).Value
          
        '为区间范围添加“、”分隔
         For i = 2 To m - 1
            S.Cells(1, 6).Value = S.Cells(1, 6).Value & "、" & S.Cells(i, 5).Value
         Next i
    End If
    
    '计算区间范围内总的整数个数
    S.Cells(1, 7) = counter + 1
    '复制到剪贴板
    S.Range("F1:G1").Copy
    
    '删除用过的选择集
    SS.Delete

End Sub