请教斑竹，如何查找重复点！看看我的程序，数量大就比较慢！（图中的点数目比较多）
aSub mody()Dim entity As AcadPoint
Dim obj As AcadPoint
Dim xx As Variant
Dim yy As Variant
Dim i As Integer
Dim k As Integer
Dim j As Integer
Dim l As Integer
Dim x As Double
Dim y As Double
Dim a As Double
Dim b As Double
Dim m As Single
m = 0
If ThisDrawing.ModelSpace.Count0 Then
i = ThisDrawing.ModelSpace.Count '图中CAD中的点的总数
k = ThisDrawing.ModelSpace.Count '图中CAD中的点的总数
For j = 0 To i - 1
Set entity = ThisDrawing.ModelSpace.Item(j) '选择一个点
xx = entity.Coordinates '将点的坐标给xx
x = xx(0) '为横坐标值
y = xx(1) '为纵坐标值
For l = k - 1 To j + 1 Step -1
Set obj = ThisDrawing.ModelSpace.Item(l)
yy = obj.Coordinates
a = yy(0)
b = yy(1)
'MsgBox a & "=" & x
If a = x And b = y Then
entity.color = acBlue '点变色
obj.color = acBlue '点变色
m = m + 1
End If
Next l
Next j
MsgBox m
Else
MsgBox "在模型空间中没有对象存在。"
End If
End Sub
'请斑竹看看，还有没有其他好的方法来找出图中大量点的程序！
既然是点坐标，就可以取出来进行排序。排序后就可以看出哪些是重复的了。
页:
[1]