使用中文建立选择集的自定义函数（免费）

vbcad

调用举例：

过滤所有单行文字
set sset=AcadEasySelect (ThisDrawing, "对象 文字")

过滤所有单行文字，高度大于10
set sset=AcadEasySelect( ThisDrawing, "对象 文字;运算符 >;高度 10")

过滤所有单行文字，高度大于10，内容中包含“你好”
set sset=AcadEasySelect (ThisDrawing, "对象 文字;运算符 >;高度 10;内容 *你好*")

过滤图层“测试”中所有单行文字，高度大于10，内容中包含“你好”
set sset=AcadEasySelect (ThisDrawing, "图层 测试;对象 文字;运算符 >;高度 10;内容 *你好*")

过滤图层“测试”中所有单行文字及多行文字，高度大于10，内容中包含“你好”
call AcadEasySelect (ThisDrawing, "图层 测试;对象 文字;运算符 >;高度 10;内容 *你好*")
set sset=AcadEasySelect (ThisDrawing, "图层 测试;对象 多行文字;运算符 >;高度 10;内容 *你好*",false)
过滤园、多段线、块等只要将 “对象 文字”改为：“对象 园”、“对象 块”、“对象 多段线”

Public Function AcadEasySelect(o_AcadDoc As Object, Optional strFilter As String = "", Optional bNewMode As Boolean = True)  As Object
' 选择过滤对象，
'o_AcadDoc 为文档对象，strFilter为过滤字符串(每组用";"分开，类型和数据用空格分开），bNewMode指定是否为新选择集
    Dim SSet As Object
    Dim SelectName As String
    Dim nSelectObj As Long
    Dim FilterType() As Integer '过滤类型
    Dim FilterData() As Variant '
    Dim tmpSplit() As String
    Dim tmpSplitItem() As String
    Dim tmpString As String, strType As String, strData As String
    Dim i As Long, j As Long
    Dim Find As Long
   
    On Error Resume Next
    SelectName = "tmp"
    Set SSet = o_AcadDoc.SelectionSets(SelectName)
    If bNewMode Then SSet.Delete
    Set SSet = o_AcadDoc.SelectionSets.Add(SelectName)
   
    ReDim FilterType(0)
    ReDim FilterData(0)
   
    If Len(strFilter) = 0 Then '选择所有对象： SSet.Select 5代表所有对象 （acSelectionSetAll）
         SSet.Select 5
    Else
        '将字符转换成过滤数组
        tmpSplitItem = Split(strFilter, ";")
        For i = 0 To UBound(tmpSplitItem)
            Find = InStr(tmpSplitItem(i), " ")
            If Find > 0 Then '如果有数据
                strType = Left(tmpSplitItem(i), Find - 1) '取得对象左边字符
                strData = Right(tmpSplitItem(i), Len(tmpSplitItem(i)) - Find)  '取得对象右边字符
                Select Case strType
                    Case "图层", "图层名"
                        strType = 8
                    Case "可见"
                        strType = 60
                        Select Case strData
                            Case "是", "真"
                                strData = 0
                            Case "否", "假"
                                strData = 1
                        End Select
                    Case "逻辑", "运算符"
                        strType = -4
                    Case "图元", "对象", "对象类型"
                        strType = 0
                        Select Case strData
                            Case "文字"
                                strData = "TEXT"
                            Case "园"
                                strData = "Circle"
                            Case "直线"
                                strData = "Line"
                            Case "多段线"
                                strData = "lwpolyline"
                            Case "多行文字"
                                strData = "MTEXT"
                            Case "块"
                                strData = "Insert"
                            Case "园"
                                strData = "Circle"
                        End Select
                    Case "内容"
                        strType = 1 '选择类型为文字内容
                    Case "块名", "名字"
                        strType = 2 '选择类型为名称（属性标记、块名等）
                    Case "颜色"
                        strType = 62
                    Case "大小", "高度", "长度", "半径"
                        strType = 40
                    
                End Select
               
                ReDim Preserve FilterType(j)
                ReDim Preserve FilterData(j)
                FilterType(j) = strType '选择类型
                FilterData(j) = strData '
                j = j + 1
            End If
        Next
        SSet.Select 5, , , FilterType, FilterData
    End If
'    For i1 = 0 To UBound(FilterData)
'    Debug.Print i1, FilterType(i1), FilterData(i1)
'    Next
    Debug.Print "选择数量："; SSet.Count '
    Set AcadEasySelect = SSet
End Function

vbcad

2. Public Function AcadEasySelect(o_AcadDoc As Object, Optional strFilter As String = "", Optional bNewMode As Boolean = True) As Object
   
3. ' 选择过滤对象，
   
4. 'o_AcadDoc 为文档对象，strFilter为过滤字符串(每组用";"分开，类型和数据用空格分开），bNewMode指定是否为新选择集
   
5.     Dim SSet As Object
   
6.     Dim SelectName As String
   
7.     Dim nSelectObj As Long
   
8.     Dim FilterType() As Integer '过滤类型
   
9.     Dim FilterData() As Variant '
   
10.     Dim tmpSplit() As String
    
11.     Dim tmpSplitItem() As String
    
12.     Dim tmpString As String, strType As String, strData As String
    
13.     Dim i As Long, j As Long
    
14.     Dim Find As Long
    
15.    
    
16.     On Error Resume Next
    
17.     SelectName = "tmp"
    
18.     Set SSet = o_AcadDoc.SelectionSets(SelectName)
    
19.     If bNewMode Then SSet.Delete
    
20.     Set SSet = o_AcadDoc.SelectionSets.Add(SelectName)
    
21.    
    
22.     ReDim FilterType(0)
    
23.     ReDim FilterData(0)
    
24.    
    
25.     If Len(strFilter) = 0 Then '选择所有对象： SSet.Select 5代表所有对象 （acSelectionSetAll）
    
26.          SSet.Select 5
    
27.     Else
    
28.         '将字符转换成过滤数组
    
29.         tmpSplitItem = Split(strFilter, ";")
    
30.         For i = 0 To UBound(tmpSplitItem)
    
31.             Find = InStr(tmpSplitItem(i), " ")
    
32.             If Find > 0 Then '如果有数据
    
33.                 strType = Left(tmpSplitItem(i), Find - 1) '取得对象左边字符
    
34.                 strData = Right(tmpSplitItem(i), Len(tmpSplitItem(i)) - Find)  '取得对象右边字符
    
35.                 Select Case strType
    
36.                     Case "图层", "图层名"
    
37.                         strType = 8
    
38.                     Case "可见"
    
39.                         strType = 60
    
40.                         Select Case strData
    
41.                             Case "是", "真"
    
42.                                 strData = 0
    
43.                             Case "否", "假"
    
44.                                 strData = 1
    
45.                         End Select
    
46.                     Case "逻辑", "运算符"
    
47.                         strType = -4
    
48.                     Case "图元", "对象", "对象类型"
    
49.                         strType = 0
    
50.                         Select Case strData
    
51.                             Case "文字"
    
52.                                 strData = "TEXT"
    
53.                             Case "园"
    
54.                                 strData = "Circle"
    
55.                             Case "直线"
    
56.                                 strData = "Line"
    
57.                             Case "多段线"
    
58.                                 strData = "lwpolyline"
    
59.                             Case "多行文字"
    
60.                                 strData = "MTEXT"
    
61.                             Case "块"
    
62.                                 strData = "Insert"
    
63.                             Case "园"
    
64.                                 strData = "Circle"
    
65.                         End Select
    
66.                     Case "内容"
    
67.                         strType = 1 '选择类型为文字内容
    
68.                     Case "块名", "名字"
    
69.                         strType = 2 '选择类型为名称（属性标记、块名等）
    
70.                     Case "颜色"
    
71.                         strType = 62
    
72.                     Case "大小", "高度", "长度", "半径"
    
73.                         strType = 40
    
74.                     
    
75.                 End Select
    
76.                
    
77.                 ReDim Preserve FilterType(j)
    
78.                 ReDim Preserve FilterData(j)
    
79.                 FilterType(j) = strType '选择类型
    
80.                 FilterData(j) = strData '
    
81.                 j = j + 1
    
82.             End If
    
83.         Next
    
84.         SSet.Select 5, , , FilterType, FilterData
    
85.     End If
    
86. '    For i1 = 0 To UBound(FilterData)
    
87. '    Debug.Print i1, FilterType(i1), FilterData(i1)
    
88. '    Next
    
89.     Debug.Print "选择数量："; SSet.Count '
    
90.     Set AcadEasySelect = SSet
    
91. End Function

Public Function AcadEasySelect(o_AcadDoc As Object, Optional strFilter As String = "", Optional bNewMode As Boolean = True) As Object<br /> ' 选择过滤对象，<br /> 'o_AcadDoc 为文档对象，strFilter为过滤字符串(每组用";"分开，类型和数据用空格分开），bNewMode指定是否为新选择集<br />     Dim SSet As Object<br />     Dim SelectName As String<br />     Dim nSelectObj As Long<br />     Dim FilterType() As Integer '过滤类型<br />     Dim FilterData() As Variant '<br />     Dim tmpSplit() As String<br />     Dim tmpSplitItem() As String<br />     Dim tmpString As String, strType As String, strData As String<br />     Dim i As Long, j As Long<br />     Dim Find As Long<br />     <br />     On Error Resume Next<br />     SelectName = "tmp"<br />     Set SSet = o_AcadDoc.SelectionSets(SelectName)<br />     If bNewMode Then SSet.Delete<br />     Set SSet = o_AcadDoc.SelectionSets.Add(SelectName)<br />     <br />     ReDim FilterType(0)<br />     ReDim FilterData(0)<br />     <br />     If Len(strFilter) = 0 Then '选择所有对象： SSet.Select 5代表所有对象 （acSelectionSetAll）<br />          SSet.Select 5<br />     Else<br />         '将字符转换成过滤数组<br />         tmpSplitItem = Split(strFilter, ";")<br />         For i = 0 To UBound(tmpSplitItem)<br />             Find = InStr(tmpSplitItem(i), " ")<br />             If Find > 0 Then '如果有数据<br />                 strType = Left(tmpSplitItem(i), Find - 1) '取得对象左边字符<br />                 strData = Right(tmpSplitItem(i), Len(tmpSplitItem(i)) - Find)  '取得对象右边字符<br />                 Select Case strType<br />                     Case "图层", "图层名"<br />                         strType = 8<br />                     Case "可见"<br />                         strType = 60<br />                         Select Case strData<br />                             Case "是", "真"<br />                                 strData = 0<br />                             Case "否", "假"<br />                                 strData = 1<br />                         End Select<br />                     Case "逻辑", "运算符"<br />                         strType = -4<br />                     Case "图元", "对象", "对象类型"<br />                         strType = 0<br />                         Select Case strData<br />                             Case "文字"<br />                                 strData = "TEXT"<br />                             Case "园"<br />                                 strData = "Circle"<br />                             Case "直线"<br />                                 strData = "Line"<br />                             Case "多段线"<br />                                 strData = "lwpolyline"<br />                             Case "多行文字"<br />                                 strData = "MTEXT"<br />                             Case "块"<br />                                 strData = "Insert"<br />                             Case "园"<br />                                 strData = "Circle"<br />                         End Select<br />                     Case "内容"<br />                         strType = 1 '选择类型为文字内容<br />                     Case "块名", "名字"<br />                         strType = 2 '选择类型为名称（属性标记、块名等）<br />                     Case "颜色"<br />                         strType = 62<br />                     Case "大小", "高度", "长度", "半径"<br />                         strType = 40<br />                     <br />                 End Select<br />                 <br />                 ReDim Preserve FilterType(j)<br />                 ReDim Preserve FilterData(j)<br />                 FilterType(j) = strType '选择类型<br />                 FilterData(j) = strData '<br />                 j = j + 1<br />             End If<br />         Next<br />         SSet.Select 5, , , FilterType, FilterData<br />     End If<br /> '    For i1 = 0 To UBound(FilterData)<br /> '    Debug.Print i1, FilterType(i1), FilterData(i1)<br /> '    Next<br />     Debug.Print "选择数量："; SSet.Count '<br />     Set AcadEasySelect = SSet<br /> End Function

zzyong00

不错，支持一下，
函数AcadEasySelect显式申明一下返回类型为好

万里天

不错,有点意思.