'****************创建带过滤器的选择集Start******************" '创建过滤集 Public Sub BuildFilter(ByRef TypeArray, ByRef DataArray, ByRef gCodes() As Variant) Dim fType() As Integer, fData() Dim index As Long, i As Long index = LBound(gCodes) - 1 For i = LBound(gCodes) To UBound(gCodes) Step 2 index = index + 1 ReDim Preserve fType(0 To index) ReDim Preserve fData(0 To index) fType(index) = CInt(gCodes(i)) fData(index) = gCodes(i + 1) Next TypeArray = fType: DataArray = fData End Sub '功能:创建选择集 Public Function CreateSelectionSet(Optional ByVal ssName As String = "ss") As AcadSelectionSet Dim ss As AcadSelectionSet On Error Resume Next Set ss = ThisDrawing.SelectionSets(ssName) If Err Then Set ss = ThisDrawing.SelectionSets.Add(ssName) ss.Clear Set CreateSelectionSet = ss End Function 'ParamArray定义的的数组在SUB内不能再做为实参传递 Public Sub BuildFilterAndCteSset(sset, ssName, ParamArray gCodes()) '定义过滤器 Dim pType, pData Dim codes() As Variant codes = gCodes BuildFilter pType, pData, codes '定义选择集 Set sset = CreateSelectionSet(ssName) '根据以上指定的过滤器建立选择集 sset.Clear sset.Select acSelectionSetAll, , , pType, pData '这里可以通过Select、SelectAtPoint、SelectByPolygon、SelectOnScreen等方法 '配合Mode和Point1、Point2建立更加用户化的选择集 End Sub '********************创建带过滤集的选择集end********************" '应用实例 '通过在CAD命令行输入:(entget(car(entsel)))获取的对象基本特性 Public Sub LayerSS() Dim sset As AcadSelectionSet BuildFilterAndCteSset sset, "ss", 8, "层名" End Sub |