[原创]PickFirstSSet改进

Public Function PickFirstSSet(Optional ByVal Type_Name As String) As AcadSelectionSet
    On Error Resume Next
    Dim SS As AcadSelectionSet
    Dim Ent As AcadEntity
    Set SS = ThisDrawing.PickfirstSelectionSet
    If SS.Count = 0 Then
        ThisDrawing.Utility.Prompt "请选择对象：" & vbCrLf
        SS.SelectOnScreen
    End If
    If Type_Name  "" Then
        Dim DelSS() As AcadEntity
        Dim i As Integer
        For Each Ent In SS
            If InStr(Type_Name, TypeName(Ent)) <= 0 Then
                ReDim Preserve DelSS(i)
                Set DelSS(i) = Ent
                i = i + 1
            End If
        Next
        SS.RemoveItems DelSS
    End If
    Set PickFirstSSet = SS
End Function

Sub CC()
     Dim Ent As AcadEntity
     Dim SS As AcadSelectionSet
     Set SS = PickFirstSSet("IAcadText2")
     For Each Ent In SS
         Ent.color = acGreen
     Next
End Sub