72
2726
9
社区元老
Private oSel As AcadSelectionSet Private TlsFt, TlsFd Private sName As StringPublic Sub NullFilter() '清空过滤器 TlsFt = Null TlsFd = Null End Sub Private Function IsNull() As Boolean If oSel Is Nothing Then IsNull = True ElseIf oSel.Count = 0 Then IsNull = True Else IsNull = False End If End Function Public Sub Init(Optional ByVal Name As String = "TlsSel") '创建选择集 On Error Resume Next NullFilter If Not oSel Is Nothing Then oSel.Delete sName = Name ThisDrawing.SelectionSets(sName).Delete Set oSel = ThisDrawing.SelectionSets.Add(sName) End Sub Private Sub Class_Terminate() '类析构时清除选择集 On Error Resume Next If Not oSel Is Nothing Then oSel.Delete End Sub Public Function ToArray() '转化选择集为对象数组输出 On Error Resume Next Dim i Dim objs() As AcadEntity Dim nCount As Integer nCount = oSel.Count - 1 ReDim objs(nCount) For i = 0 To nCount Set objs(i) = oSel(i) Next i ToArray = objs End Function Public Property Get Count() As Integer '获取选择集实体个数 On Error Resume Next Count = oSel.Count End Property Public Property Get Name() As String '获取选择集名称 On Error Resume Next Name = sName End PropertyPublic Property Get Item(ByVal Index) As AcadEntity '获取选择集实体 On Error Resume Next Set Item = oSel(Index) End Property Public Sub AddItems(ByVal objs) '向选择集加入实体 On Error Resume Next If IsArray(objs) Then oSel.AddItems objs ElseIf IsObject(objs) Then Dim ents(0) As AcadEntity Set ents(0) = objs oSel.AddItems ents End If End Sub Public Sub RemoveItems(ByVal objs) '在选择集中移除实体 On Error Resume Next If IsArray(objs) Then oSel.RemoveItems objs ElseIf IsObject(objs) Then Dim ents(0) As AcadEntity Set ents(0) = objs oSel.RemoveItems ents End If End Sub Public Sub Clear() '清空选择集 On Error Resume Next Select Case sName Case "PICKFIRST" GetPickfirstSel Case "CURRENT" GetActiveSel Case Else Init sName End Select oSel.Clear End Sub Public Sub Update() On Error Resume Next oSel.Update