选择集内多段线排序问题

tataki

大家好，我的一张图纸里有5个封闭的多段线图形，我要将他们在选择集内按照面积从大到小的顺序提取出来，可是我用下面的代码为什么没有结果呢，明明符合冒泡的交换原则，但是选择集里面的顺序没有改变。
在开始排序前，对sset中 item（0），item（1）...的面积进行显示，分别是
70649.8308504972
568562.9282529
41212.9767410917
122193.519887502
2910000
在排序后，再从item（0）开始显示面积，结果仍然和前面的一样，请大家指导一下究竟是哪里不对？
附上程序代码和图纸。谢谢！



Sub PartSequence()

Dim ftype(0 To 1) As Integer
Dim fdata(0 To 1) As Variant

ftype(0) = 0: fdata(0) = "LWPolyline" '定义过滤器筛选类别，筛选 多段线
ftype(1) = 8: fdata(1) = "parts" '定义过滤器筛选图层，筛选 parts图层

  On Error Resume Next
  Dim SSet As AcadSelectionSet
     If Not IsNull(ThisDrawing.SelectionSets.Item("SSetParts")) Then
         Set SSet = ThisDrawing.SelectionSets.Item("SSetParts")
        SSet.Delete
    End If
Set SSet = ThisDrawing.SelectionSets.Add("SSetParts")
SSet.Select acSelectionSetAll, , , ftype, fdata


'从item0开始逐个显示排序前的面积
Dim ipart As AcadLWPolyline
For i = 0 To SSet.Count - 1
     Set ipart = SSet.Item(i)
     Debug.Print ipart.Area
Next

'要对sset里面的数据按照面积从大到小的顺序排序
   
    Dim iOuter As Long
    Dim iInner As Long
    Dim iLBound As Long
    Dim iUBound As Long
    Dim iTemp As IAcadLWPolyline
    Dim iTempA As IAcadLWPolyline
    Dim iTempB As IAcadLWPolyline

    iLBound = 0
    iUBound = SSet.Count
      Debug.Print SSet.Item(0).ObjectID; SSet.Item(1).ObjectID; SSet.Item(2).ObjectID
    '冒泡排序 从大到小
    For jj = 0 To SSet.Count - 2
        For ii = 0 To SSet.Count - 1 - jj
           Set iTempA = SSet.Item(ii)
           Set iTempB = SSet.Item(ii + 1)

            '比较相邻项
            If (iTempA.Area < iTempB.Area) Then
                '交换值
                Set iTemp = SSet.Item(ii + 1)
                SSet.Item(ii + 1) = SSet.Item(ii)
                SSet.Item(ii) = iTemp
            End If
        Debug.Print SSet.Item(0).ObjectID; SSet.Item(1).ObjectID; SSet.Item(2).ObjectID
        Next ii
    Next jj
   
'从item0开始逐个显示排序后的面积
Dim ipart2 As AcadLWPolyline
For i = 0 To SSet.Count - 1
     Set ipart2 = SSet.Item(i)
     Debug.Print ipart2.Area
Next
   
   
End Sub

万里天

给你个解决办法:
Sub 多段线按面积按大小输出()
    Dim SSet As AcadSelectionSet
    Dim ftype(0 To 1) As Integer
    Dim fdata(0 To 1) As Variant

    ftype(0) = 0: fdata(0) = "LWPolyline" '定义过滤器筛选类别，筛选 多段线
    ftype(1) = 8: fdata(1) = "*" '定义过滤器筛选图层，筛选 parts图层
    On Error Resume Next
    If Not IsNull(ThisDrawing.SelectionSets.Item("SSetParts")) Then Set SSet = ThisDrawing.SelectionSets.Item("SSetParts"): SSet.Delete
    On Error GoTo 0
    Set SSet = ThisDrawing.SelectionSets.Add("SSetParts")
    SSet.Select acSelectionSetAll, , , ftype, fdata

    '选择集转换为对象数组:返回包含于选择集中每一项目的变体数组
    Dim i As Long
    Dim retVal() As AcadEntity
    ReDim retVal(0 To SSet.Count - 1)
    For i = 0 To SSet.Count - 1
        Set retVal(i) = SSet.Item(i)
        Debug.Print SSet.Item(i).area   '逐个显示排序前的面积
    Next
   
    '冒泡排序:按照面积从小到大的顺序
    Dim iOuter As Long
    Dim iInner As Long
    Dim iLBound As Long
    Dim iUBound As Long
    Dim iTemp As AcadEntity

    iLBound = LBound(retVal):    iUBound = UBound(retVal)

    '冒泡排序
    For iOuter = iLBound To iUBound - 1
        For iInner = iLBound To iUBound - iOuter - 1
            If retVal(iInner).area > retVal(iInner + 1).area Then '比较相邻项
                Set iTemp = retVal(iInner)
                Set retVal(iInner) = retVal(iInner + 1) '交换
                Set retVal(iInner + 1) = iTemp
            End If
        Next iInner
    Next iOuter

    Debug.Print "面积从小到大排序结果: "
    Dim ipart2 As AcadEntity
    For i = 0 To UBound(retVal)
        Set ipart2 = retVal(i)
        Debug.Print ipart2.area
    Next
End Sub

万里天

根本没那么玄乎.

mikewolf2k

建议楼主将 On Error Resume Next去掉，然后一步步的调试，每次交换完毕看看是否交换成功。这种问题很容易自己解决的。

tataki

这么快就回复了，非常感谢！
我去掉 on error后，再这一行出现了错误
SSet.Item(ii + 1) = SSet.Item(ii)
也就是交换选择集内的顺序时不对，错误提示 为对象不支持该属性或方法
这一点不太理解，如果是数组的话，这样使用没有任何问题，
可是到了选择集，为什么这样用就错了呢？

mikewolf2k

tataki 发表于 2016-1-5 11:55
这么快就回复了，非常感谢！
我去掉 on error后，再这一行出现了错误
SSet.Item(ii + 1) = SSet.Item(ii) ...

有这个可能性啊。选择集里的顺序毕竟是ACAD内部根据一定的规则得到的，如果任意调整这个规则可能会导致其它错误的话，禁止这项功能完全可能。
既然发现这个问题，那么就另外弄个数组，把选择集里的元素按自己的要求加进去好了。

zzyong00

楼上说的对呀，楼主的思维太独特了

tataki

zzyong00 发表于 2016-1-5 14:01
楼上说的对呀，楼主的思维太独特了

我不太熟悉选择集里面顺序的要求，但是我觉得自己的想法很正常啊，如果遇到一个类似数组的，我第一个想法就是直接在数组内部去调换移动，自然不是再去弄个数组啊，再去弄个数组不是麻烦么。不知道你为何觉得我思维独特....

mikewolf2k

tataki 发表于 2016-1-5 14:48
我不太熟悉选择集里面顺序的要求，但是我觉得自己的想法很正常啊，如果遇到一个类似数组的，我第一个想法 ...

想法没问题，我也一样会先这么想，能利用现有的资源就利用。用不上了才新建。现在既然发现了这个问题，那么新建数组就解决了哈~

tataki

谢谢楼上提示，已经成功搞定！

tataki

tataki 发表于 2016-1-5 14:48
我不太熟悉选择集里面顺序的要求，但是我觉得自己的想法很正常啊，如果遇到一个类似数组的，我第一个想法 ...

原来这个涉及到CAD的数据库了吗？晕死。我还以为也只是普通的数组呢。
对CAD的理解还没有到达你的高度，分辨不出哪些是我可以改动的，哪些不能改动，能再举些例子吗？还请多多指导！

tataki

zzyong00 发表于 2016-1-5 14:01
楼上说的对呀，楼主的思维太独特了

原来这个涉及到CAD的数据库了吗？晕死。我还以为也只是普通的数组呢。
对CAD的理解还没有到达你的高度，分辨不出哪些是我可以改动的，哪些不能改动，能再举些例子吗？还请多多指导！