兰州人 发表于 2008-3-31 15:03:00

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

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

程序如下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 发表于 2018-4-10 08:39:31

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

elepeipei 发表于 2018-5-6 10:53:31

谢谢版主分享不重复数组

redarrow2000 发表于 2018-5-10 20:52:51

谢谢版主分享

一只鸟243aZ 发表于 2018-6-13 14:00:57

一只鸟243aZ 发表于 2018-6-13 14:02:02

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

nacl_cn 发表于 2018-8-17 17:50:43

我想问一下，去重为什么不用字典技术，而且还可以计数
页: [1]
查看完整版本: [原创]遍历图形，用不重复数组技术，找出图形中有多少类型实体。