选择集的怪问题

bsirhell · 发表于 2006-7-11 21:05:00

欲将选择集中的同心圆半径小的那个去掉，结果却将所有的小圆都去掉了，图形中只剩下半径最大的圆了，以下是源程序，还请高手指教！
For Each element In SSet
   Dim i As Integer
   Dim j As Integer
   Dim obj1 As AcadCircle
   Dim obj2 As AcadCircle

   For i = 0 To SSet.Count - 1
   For j = 0 To SSet.Count - 1
      Set obj1 = SSet.Item(i)
      Set obj2 = SSet.Item(j)
      If obj1.Center = obj2.Center Then
      If obj1.Radius > obj2.Radius Then



      SSet.Item(j).Delete
      Update
      End If
      End If
      Next j
      Next i
本意是在选择集中删除，用ERASE方法也没用，

wangiron · 发表于 2006-7-11 22:59:00

Set obj1 = SSet.Item(i)
Set obj2 = SSet.Item(j)
有问题

mccad · 发表于 2006-7-12 07:07:00

圆心的位置不是这样比较的吧。三个坐标都需要比较。

雪山飞狐_lzh · 发表于 2006-7-12 10:24:00

For循环也错了，应该这样
For i = SSet.Count - 1 To 0 setp -1
For j = SSet.Count - 1 To 0 setp -1

霹雳啪啦啦 · 发表于 2006-7-12 12:26:00

关键是循环的问题。当外层的i循环第一次循环时，j变量就从选择集第一个找起，比较半径，所有半径比item(i)的圆小的同心圆就全删光了。如果第一次外层循环的i变量对应的圆就使半径最大的，只要外层的第一次循环就只剩下半径最大的圆了。
如果你只要删除所有同心圆中半径最小的，那么就是在一个序列中查找最小值的问题，应该首先进行比较，找到最小的后，退出所有循环才能删除。而不是一边比较一边删除，那这个序列就给你破坏了。

bsirhell · 发表于 2006-7-13 12:20:00

先谢谢！
能否给出解决问题的代码！

bsirhell · 发表于 2006-7-17 20:18:00

For Each element In SSet
   Dim i As Integer
   Dim j As Integer
   Dim obj1 As AcadCircle
   Dim obj2 As AcadCircle

For i = SSet.Count - 1 To 0 setp -1
   For j = SSet.Count - 1 To 0 setp -1
  Set obj1 = SSet.Item(i)
      Set obj2 = SSet.Item(j)
      dim pt1(0 to 2) as  double
      dim pt2(0 to 2) as  double
pt1=obj1.center
pt2=obj2.center
if pt1(0)=pt2(0):pt1(1)=pt(2)1:pt1(2)=pt2(2) then
      SSet.Item(j).Delete
      Update
      End If
      End If
      Next j
      Next i
问题依旧！
能否再将解答详细点！谢谢！

霹雳啪啦啦 · 发表于 2006-7-19 13:37:00

'在下列程序前，首先生成只包括圆的sset选择集
Dim delArray(0) As AcadCircle
Dim delSet As AcadSelectionSet
Set delSet = ThisDrawing.SelectionSets.Add("delset1")
   Dim i As Integer
   Dim j As Integer
   Dim obj1 As AcadCircle
   Dim obj2 As AcadCircle

   For i = 0 To sset.Count - 1
   Set delArray(0) = sset.Item(i)
   For j = 0 To sset.Count - 1
         Set obj2 = sset.Item(j)
      If delArray(0).Center(0) = obj2.Center(0) And delArray(0).Center(1) = obj2.Center(1) Then
      If delArray(0).Radius > obj2.Radius Then
      Set delArray(0) = obj2
      End If
      End If
   Next j
      delSet.AddItems delArray
      Next i

delSet.Erase

使用上述程序，不知达到你的要求吗？

bsirhell · 发表于 2006-7-21 21:48:00

非常感谢！

选择集的怪问题

发表回复

精选推荐