[原创]遍历图形，用不重复数组技术，找出图形中有多少类型实体。

兰州人

遍历图形中共有 56 (n)个实体类型
不重复排序后，图形中有  6 种类型    实体
分别是
1            AcDbRotatedDimension
2            AcDbMText
3            AcDbLine
4            AcDbZombieEntity
5            AcDbRadialDimension
6            AcDbArc

程序如下

2. Sub ls()
3.   Dim Ent As AcadEntity
4.   Dim SelectEntityArray() As String, ReturnEntityArray() As Variant
5.   ReDim SelectEntityArray(ThisDrawing.ModelSpace.Count - 1) As String
6.   ii = 0
7.   For ii = 0 To ThisDrawing.ModelSpace.Count - 1
8.     SelectEntityArray(ii) = ThisDrawing.ModelSpace.Item(ii).ObjectName
9.   Next ii
10.   Debug.Print TypeName(SelectEntityArray)
11.   ReturnEntityArray = NoRepeatArray(SelectEntityArray)
12.   
13.   Debug.Print "图形中共有", ThisDrawing.ModelSpace.Count, "个实体类型"
14.   Debug.Print "不重复排序后，图形中有", UBound(ReturnEntityArray), "实体类型"
15.   'Debug.Print "1222222222   ", UBound(NoRepeatArray(SelectEntityArray))
16.   Debug.Print
17.   For ii = 1 To UBound(ReturnEntityArray)
18.     Debug.Print ii, ReturnEntityArray(ii)
19.   Next ii
20. End Sub
21. Function NoRepeatArray(xm) 'As Variant()
22.     Dim Arr, Temp() As String '声明变量
23.     Dim s%, r% '声明单值变量
24.     On Error Resume Next '启动一个错误处理程序
25.      
26.     r = 0 '初值
27.     s = UBound(xm) '最大下标
28.     ReDim Arr(s - 1)
29.     For I = 0 To s '循环
30.         Temp = Filter(Arr, xm(I)) '搜索数组
31.         If UBound(Temp) = -1 Then '如果未找到
32.             r = r + 1 '序号，自增1
33.             ReDim Preserve Arr(1 To r)  '定义动态数组大小
34.             Arr(r) = xm(I) '把姓名复制到数组Arr()中。
35.         End If
36.     Next
37.     NoRepeatArray = Arr
38.    
39. End Function

Sub ls()   Dim Ent As AcadEntity   Dim SelectEntityArray() As String, ReturnEntityArray() As Variant   ReDim SelectEntityArray(ThisDrawing.ModelSpace.Count - 1) As String   ii = 0   For ii = 0 To ThisDrawing.ModelSpace.Count - 1     SelectEntityArray(ii) = ThisDrawing.ModelSpace.Item(ii).ObjectName   Next ii   Debug.Print TypeName(SelectEntityArray)   ReturnEntityArray = NoRepeatArray(SelectEntityArray)      Debug.Print "图形中共有", ThisDrawing.ModelSpace.Count, "个实体类型"   Debug.Print "不重复排序后，图形中有", UBound(ReturnEntityArray), "实体类型"   'Debug.Print "1222222222   ", UBound(NoRepeatArray(SelectEntityArray))   Debug.Print   For ii = 1 To UBound(ReturnEntityArray)     Debug.Print ii, ReturnEntityArray(ii)   Next ii End Sub Function NoRepeatArray(xm) 'As Variant()     Dim Arr, Temp() As String '声明变量     Dim s%, r% '声明单值变量     On Error Resume Next '启动一个错误处理程序           r = 0 '初值     s = UBound(xm) '最大下标     ReDim Arr(s - 1)     For I = 0 To s '循环         Temp = Filter(Arr, xm(I)) '搜索数组         If UBound(Temp) = -1 Then '如果未找到             r = r + 1 '序号，自增1             ReDim Preserve Arr(1 To r)  '定义动态数组大小             Arr(r) = xm(I) '把姓名复制到数组Arr()中。         End If     Next     NoRepeatArray = Arr     End Function

----------------------
Sub ls()
  Dim Ent As AcadEntity
  Dim SelectEntityArray() As String, ReturnEntityArray() As Variant
  ReDim SelectEntityArray(ThisDrawing.ModelSpace.Count - 1) As String
  ii = 0
  For ii = 0 To ThisDrawing.ModelSpace.Count - 1
    SelectEntityArray(ii) = ThisDrawing.ModelSpace.Item(ii).ObjectName
  Next ii
  Debug.Print TypeName(SelectEntityArray)
  ReturnEntityArray = NoRepeatArray(SelectEntityArray)
  
  Debug.Print "图形中共有", ThisDrawing.ModelSpace.Count, "个实体类型"
  Debug.Print "不重复排序后，图形中有", UBound(ReturnEntityArray), "实体类型"
  'Debug.Print "1222222222   ", UBound(NoRepeatArray(SelectEntityArray))
  Debug.Print
  For ii = 1 To UBound(ReturnEntityArray)
    Debug.Print ii, ReturnEntityArray(ii)
  Next ii
End Sub
Function NoRepeatArray(xm) 'As Variant()
    Dim Arr, Temp() As String '声明变量
    Dim s%, r% '声明单值变量
    On Error Resume Next '启动一个错误处理程序
     
    r = 0 '初值
    s = UBound(xm) '最大下标
    ReDim Arr(s - 1)
    For I = 0 To s '循环
        Temp = Filter(Arr, xm(I)) '搜索数组
        If UBound(Temp) = -1 Then '如果未找到
            r = r + 1 '序号，自增1
            ReDim Preserve Arr(1 To r)  '定义动态数组大小
            Arr(r) = xm(I) '把姓名复制到数组Arr()中。
        End If
    Next
    NoRepeatArray = Arr
   
End Function

dong20030432

非常好，感谢您的分享！！！

elepeipei

谢谢版主分享不重复数组

redarrow2000

谢谢版主分享

一只鸟243aZ

一只鸟243aZ

很有帮助。
能否把所有的对象，数量都做出来？
多谢谢谢谢谢谢谢！！！！！！

nacl_cn

我想问一下，去重为什么不用字典技术，而且还可以计数