vbcad 发表于 2015-1-4 16:08:17

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

本帖最后由 vbcad 于 2015-1-5 14:56 编辑

调用举例：

过滤所有单行文字
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 发表于 2015-1-4 16:09:04

本帖最后由 vbcad 于 2015-1-5 14:57 编辑

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

zzyong00 发表于 2015-1-4 22:56:57

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

万里天 发表于 2016-3-3 16:58:17

不错,有点意思.
页: [1]
查看完整版本: 使用中文建立选择集的自定义函数（免费）