社区 › VBA/VB/ActiveX/API 编程技术 › [原创]PickFirstSSet改进

lennie 发表于 2008-5-11 21:05:00

[原创]PickFirstSSet改进

本帖最后由 作者 于 2008-5-11 21:09:30 编辑

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

lennie 发表于 2008-5-12 11:40:00

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

查看完整版本: [原创]PickFirstSSet改进