[求助]：'请教，做重复点用acSelectionSetCrossing选择,有时候旁边的点也变红!

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   '这里我只是把同构xyz坐标的点给选出来，但是有时候图放的很小时，会把xyz旁边的点选中，但是如果把图放大后，这个在xyz旁边的点就不会被选中，不知道是什么原因，请指教？

     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上的点吗,但是程序运行,有的时候它旁边的点也变红,不知道是怎么回事,请指教!

雪山飞狐(lzh)

可以用dxf组码10做过滤条件

huazhijia

怎么用10作为过滤手段呢？