请斑竹过来看看,重复点程序有无问题?请指教!

huazhijia

Sub delchongfupoint()
Dim entity As AcadPoint
Dim xyz As Variant
Dim i As Double
Dim j As Double
Dim counter As Integer
Dim ftype(0 To 1) As Integer
Dim fdata(0 To 1) As Variant
Dim sset As AcadSelectionSet
'初始颜色是acwhite；扫描过的颜色是acblue；重合点的颜色是acred
If ThisDrawing.ModelSpace.Count <> 0 Then
  i = ThisDrawing.ModelSpace.Count
'先循环一下，初始化设置所有的颜色为acwhite,如果已知颜色的话是不需要做的
  For j = 0 To i - 1
      Set entity = ThisDrawing.ModelSpace.Item(j)
      entity.Color = acWhite
  Next j
  For j = 0 To i - 1
      Set entity = ThisDrawing.ModelSpace.Item(j)
      xyz = entity.Coordinates  '取得点的坐标
'判断图形中是否已经存在同名的选择集
  On Error Resume Next
     If Not IsNull(ThisDrawing.SelectionSets.Item("sset")) Then
        Set sset = ThisDrawing.SelectionSets.Item("sset")
        sset.Delete    '及时删除不用的选择集非常重要
     End If
'创建新选择集
     Set sset = ThisDrawing.SelectionSets.Add("sset")
     If Err Then Set sset = ThisDrawing.SelectionSets.Add("sset")
        sset.Clear
'指定过滤机制
  ftype(0) = 0: fdata(0) = "point"
  ftype(1) = 8: fdata(1) = "*"       '图层名
'使用crossing的选择模式
  sset.Select acSelectionSetCrossing, xyz, xyz, ftype, fdata
     Dim obj As AcadPoint
     For Each obj In sset
      If obj.Color = acBlue Then
         obj.Color = acRed
      End If
      If obj.Color = acWhite Then
         obj.Color = acBlue
      End If
     Next
  Next j
MsgBox "描点结束！"
Else
MsgBox "在模型空间中没有对象存在。"
End If
End Sub

'请教斑竹,我用acSelectionSetCrossing时,不是只选择这个xyz上的点吗,但是程序运行,有的时候它旁边的点也变红,不知道是怎么回事,请指教!

这是我根据买你的VBA书写的,请赐教!

esri

cad用点来选择是不准的!

huazhijia

那么怎么根据一个坐标，将这个坐标上所有的点能选中呢？