本帖最后由 作者 于 2008-5-11 21:09:30 编辑
此函数用于VBA程序,先选择后操作 详见 原帖增添了简单的过滤功能
最理想的过滤方式应该是SS.Select acSelectionSetPrevious,,, FilterType, FilterData
就是不知道怎么样把PickfirstSelectionSet变成SelectionSetPrevious - 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
|