[原创]PickFirstSSet改进

lennie

此函数用于VBA程序，先选择后操作 详见 原帖增添了简单的过滤功能
最理想的过滤方式应该是SS.Select acSelectionSetPrevious,,, FilterType, FilterData
就是不知道怎么样把PickfirstSelectionSet变成SelectionSetPrevious

2. Public Function PickFirstSSet(Optional ByVal Type_Name As String) As AcadSelectionSet
3.     On Error Resume Next
4.     Dim SS As AcadSelectionSet
5.     Dim Ent As AcadEntity
6.     Set SS = ThisDrawing.PickfirstSelectionSet
7.     If SS.Count = 0 Then
8.         ThisDrawing.Utility.Prompt "请选择对象：" & vbCrLf
9.         SS.SelectOnScreen
10.     End If
11.     If Type_Name <> "" Then
12.         Dim DelSS() As AcadEntity
13.         Dim i As Integer
14.         For Each Ent In SS
15.             If InStr(Type_Name, TypeName(Ent)) <= 0 Then
16.                 ReDim Preserve DelSS(i)
17.                 Set DelSS(i) = Ent
18.                 i = i + 1
19.             End If
20.         Next
21.         SS.RemoveItems DelSS
22.     End If
23.     Set PickFirstSSet = SS
24. End Function

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

简单示例（只修改文字对象的颜色）：

2. Sub CC()
3.      Dim Ent As AcadEntity
4.      Dim SS As AcadSelectionSet
5.      Set SS = PickFirstSSet("IAcadText2")
6.      For Each Ent In SS
7.          Ent.color = acGreen
8.      Next
9. End Sub

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

lennie

今天使用时发现错误: Visual LISP command document mismatch: TB