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.Count <> 0 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
'请斑竹看看,还有没有其他好的方法来找出图中大量点的程序! |