[求助]：一个选择集的使用问题，高手请指教

天边孤雁

各位高手：
     选择集是否可以嵌套使用？以下是我调试的代码，在用SelectOnScreen做了 选择集后，对选择集的PLINE对象操作过程中，又需要以该对象的一个点的为中心的建立一个近似圆的多边形，用这个多边形再做选择集。程序调试到 ：Set SelPoly = ThisDrawing.SelectionSets.Add("SelP") 语句就不执行，好像是选择集的嵌套出现了问题，什么原因？如果选择集不能嵌套使用，又有什么办法可以解决该问题？请教了。敬请高手费心。

Sub chkpline()

    ' 创建选择集
    Dim sset As Object
    Set sset = ThisDrawing.SelectionSets.Add("SS1")

    On Error GoTo xxx
    ' 提示用户选择对象
    sset.SelectOnScreen
  Dim selsetCollection As AcadSelectionSets
  Dim selset As AcadSelectionSet
  Dim SelPoly As AcadSelectionSet
  Dim Ent As AcadObject
  Dim circleObj As AcadObject
  Dim offsetOb As AcadObject
  Dim i, j, k, m As Integer
  Dim n As Integer
  Dim vps As Variant
  Dim cen(0 To 2) As Double
  Dim cen1(0 To 2) As Double
  Dim NewCoord(0 To 23) As Double
  Dim ying As String
  Dim plineObj As AcadPolyline
  'Dim dis, yjq As Double
  ying = ThisDrawing.Utility.GetString(False, "两点相距多少视为一点<0.02：")
    If Trim(ying) = "" Then
     ying = "0.02
  End If
  Set selsetCollection = ThisDrawing.SelectionSets
   
  ' 查找图形中的每个选择集
  i = 0
  For Each selset In selsetCollection
       MsgBox "Selection set  is: " & selset.count

     ' 现在查找选择集中的每个对象，同时显示其类型
     j = 0
     'ReDim newObjs(selset.count) As AcadObject

     For i = 0 To selset.count - 1
         Set Ent = selset.Item(i)
         If Ent.ObjectName = "AcDbPolyline" Then
            vps = Ent.Coordinates
                   MsgBox "i= " & i
            For k = 0 To UBound(vps) - 1 Step 2
            
                NewCoord(0) = vps(k) - Val(ying) / 1.414
                NewCoord(1) = vps(k + 1) + Val(ying) / 1.414
                NewCoord(2) = 0
                NewCoord(3) = vps(k)
                NewCoord(4) = vps(k + 1) + Val(ying)
                NewCoord(5) = 0
                NewCoord(6) = vps(k) + Val(ying) / 1.414
                NewCoord(7) = vps(k + 1) + Val(ying) / 1.414
                NewCoord(8) = 0
                NewCoord(9) = vps(k) + Val(ying)
                NewCoord(10) = vps(k + 1)
                NewCoord(11) = 0
                NewCoord(12) = vps(k) + Val(ying) / 1.414
                NewCoord(13) = vps(k + 1) - Val(ying) / 1.414
                NewCoord(14) = 0
                NewCoord(15) = vps(k)
                NewCoord(16) = vps(k + 1) - Val(ying)
                NewCoord(17) = 0
                NewCoord(18) = vps(k) - Val(ying) / 1.414
                NewCoord(19) = vps(k + 1) - Val(ying) / 1.414
                NewCoord(20) = 0
                NewCoord(21) = vps(k) - Val(ying)
                NewCoord(22) = vps(k + 1)
                NewCoord(23) = 0

               ' Set plineObj = ThisDrawing.ModelSpace.AddPolyline(NewCoord)

       MsgBox "k=: " & k
                Set SelPoly = ThisDrawing.SelectionSets.Add("SelP")
                SelPoly.SelectByPolygon acSelectionSetCrossingPolygon, NewCoord
                If SelPoly.count > 1 Then
                  Set circleObj = ThisDrawing.ModelSpace.AddCircle(cen, 5)
                   circleObj.Color = acGreen
                End If
                ThisDrawing.SelectionSets.Item("SelP").Delete
            Next

        End If
     Next
  Next
xxx:
    ThisDrawing.SelectionSets.Item("SS1").Delete
End Sub

雪山飞狐(lzh)

使用选择集前，先强行删除同名选择集，你可以做这样的函数
function CreateSS(Name as string)
on error resume next
ThisDrawing.SelectionSets.Item(Name).Delete
set CreateSS = ThisDrawing.SelectionSets.Add(Name)
end function

天边孤雁

我采用了 在建立选择集前，删除所有的选择集。还有对多个选择集操作时候，可以设置活动的（当前）选择集，问题是接着就出来了，程序根本不按照我的思路来执行，请飞狐兄及其他的高手指教。（附有试验用的数据，请大家帮忙看看吧）
'悬垂点的检查
'悬垂点的检查

Sub chkpline()

    ' 创建选择集
   Dim i, j, k, m, e As Integer
    Dim sset As Object
    For e = 0 To ThisDrawing.SelectionSets.count - 1
        ThisDrawing.SelectionSets.Item(e).Delete
    Next

    Set sset = ThisDrawing.SelectionSets.Add("SS1")

    On Error GoTo xxx
    ' 提示用户选择对象
    sset.SelectOnScreen
  Dim selsetCollection As AcadSelectionSets
  Dim selset As AcadSelectionSet
  Dim SelPoly As AcadSelectionSet
  Dim Ent As AcadObject
  Dim circleObj As AcadObject
  Dim offsetOb As AcadObject
  Dim n As Integer
  Dim vps As Variant
  Dim cen(0 To 2) As Double
  Dim cen1(0 To 2) As Double
  Dim NewCoord(0 To 23) As Double
  Dim ying As String
  Dim plineObj As AcadPolyline
  'Dim dis, yjq As Double
  ying = ThisDrawing.Utility.GetString(False, "两点相距多少视为一点<0.05>：")
    If Trim(ying) = "" Then
     ying = "0.05"
  End If
  Set selsetCollection = ThisDrawing.SelectionSets
   
  ' 查找图形中的每个选择集
  i = 0
  j = 0
  For Each selset In selsetCollection
                 MsgBox "Selectionsets nub  is: " & ThisDrawing.SelectionSets.count
       MsgBox "Selectionset下的对象数目: " & selset.count

     ' 现在查找选择集中的每个对象，同时显示其类型

     'ReDim newObjs(selset.count) As AcadObject

     For i = 0 To selset.count - 1
         Set Ent = selset.Item(i)
         If Ent.ObjectName = "AcDbPolyline" Then
            vps = Ent.Coordinates
                   MsgBox "i= " & i
            For k = 0 To UBound(vps) - 1 Step 2
                cen(0) = vps(k)
                cen(1) = vps(k + 1)
                cen(2) = 0

                NewCoord(0) = vps(k) - Val(ying) / 1.414
                NewCoord(1) = vps(k + 1) + Val(ying) / 1.414
                NewCoord(2) = 0
                NewCoord(3) = vps(k)
                NewCoord(4) = vps(k + 1) + Val(ying)
                NewCoord(5) = 0
                NewCoord(6) = vps(k) + Val(ying) / 1.414
                NewCoord(7) = vps(k + 1) + Val(ying) / 1.414
                NewCoord(8) = 0
                NewCoord(9) = vps(k) + Val(ying)
                NewCoord(10) = vps(k + 1)
                NewCoord(11) = 0
                NewCoord(12) = vps(k) + Val(ying) / 1.414
                NewCoord(13) = vps(k + 1) - Val(ying) / 1.414
                NewCoord(14) = 0
                NewCoord(15) = vps(k)
                NewCoord(16) = vps(k + 1) - Val(ying)
                NewCoord(17) = 0
                NewCoord(18) = vps(k) - Val(ying) / 1.414
                NewCoord(19) = vps(k + 1) - Val(ying) / 1.414
                NewCoord(20) = 0
                NewCoord(21) = vps(k) - Val(ying)
                NewCoord(22) = vps(k + 1)
                NewCoord(23) = 0
                 Set SelPoly = ThisDrawing.SelectionSets.Add("SelP0")
                Set SelPoly = ThisDrawing.ActiveSelectionSet
                ThisDrawing.SelectionSets.Item("SelP0").Clear
                SelPoly.SelectByPolygon acSelectionSetCrossingPolygon, NewCoord
    MsgBox "SelPoly.count: " & SelPoly.count
                If SelPoly.count > 1 Then
                   Set circleObj = ThisDrawing.ModelSpace.AddCircle(cen, 5)
                   circleObj.Color = acGreen
                End If
               ' Set plineObj = ThisDrawing.ModelSpace.AddPolyline(NewCoord)
                Set sset = ThisDrawing.ActiveSelectionSet
                ThisDrawing.SelectionSets.Item("SelP0").Delete
            Next

        End If
     Next
  Next
xxx:

    ThisDrawing.SelectionSets.Item("SS1").Delete

End Sub

Sub chkpline()

    ' 创建选择集
   Dim i, j, k, m, e As Integer
    Dim sset As Object
    For e = 0 To ThisDrawing.SelectionSets.count - 1
        ThisDrawing.SelectionSets.Item(e).Delete
    Next

    Set sset = ThisDrawing.SelectionSets.Add("SS1")

    On Error GoTo xxx
    ' 提示用户选择对象
    sset.SelectOnScreen
  Dim selsetCollection As AcadSelectionSets
  Dim selset As AcadSelectionSet
  Dim SelPoly As AcadSelectionSet
  Dim Ent As AcadObject
  Dim circleObj As AcadObject
  Dim offsetOb As AcadObject
  Dim n As Integer
  Dim vps As Variant
  Dim cen(0 To 2) As Double
  Dim cen1(0 To 2) As Double
  Dim NewCoord(0 To 23) As Double
  Dim ying As String
  Dim plineObj As AcadPolyline
  'Dim dis, yjq As Double
  ying = ThisDrawing.Utility.GetString(False, "两点相距多少视为一点<0.05>：")
    If Trim(ying) = "" Then
     ying = "0.05"
  End If
  Set selsetCollection = ThisDrawing.SelectionSets
   
  ' 查找图形中的每个选择集
  i = 0
  j = 0
  For Each selset In selsetCollection
                 MsgBox "Selectionsets nub  is: " & ThisDrawing.SelectionSets.count
       MsgBox "Selectionset下的对象数目: " & selset.count

     ' 现在查找选择集中的每个对象，同时显示其类型

     'ReDim newObjs(selset.count) As AcadObject

     For i = 0 To selset.count - 1
         Set Ent = selset.Item(i)
         If Ent.ObjectName = "AcDbPolyline" Then
            vps = Ent.Coordinates
                   MsgBox "i= " & i
            For k = 0 To UBound(vps) - 1 Step 2
                cen(0) = vps(k)
                cen(1) = vps(k + 1)
                cen(2) = 0

                NewCoord(0) = vps(k) - Val(ying) / 1.414
                NewCoord(1) = vps(k + 1) + Val(ying) / 1.414
                NewCoord(2) = 0
                NewCoord(3) = vps(k)
                NewCoord(4) = vps(k + 1) + Val(ying)
                NewCoord(5) = 0
                NewCoord(6) = vps(k) + Val(ying) / 1.414
                NewCoord(7) = vps(k + 1) + Val(ying) / 1.414
                NewCoord(8) = 0
                NewCoord(9) = vps(k) + Val(ying)
                NewCoord(10) = vps(k + 1)
                NewCoord(11) = 0
                NewCoord(12) = vps(k) + Val(ying) / 1.414
                NewCoord(13) = vps(k + 1) - Val(ying) / 1.414
                NewCoord(14) = 0
                NewCoord(15) = vps(k)
                NewCoord(16) = vps(k + 1) - Val(ying)
                NewCoord(17) = 0
                NewCoord(18) = vps(k) - Val(ying) / 1.414
                NewCoord(19) = vps(k + 1) - Val(ying) / 1.414
                NewCoord(20) = 0
                NewCoord(21) = vps(k) - Val(ying)
                NewCoord(22) = vps(k + 1)
                NewCoord(23) = 0
                 Set SelPoly = ThisDrawing.SelectionSets.Add("SelP0")
                Set SelPoly = ThisDrawing.ActiveSelectionSet
                ThisDrawing.SelectionSets.Item("SelP0").Clear
                SelPoly.SelectByPolygon acSelectionSetCrossingPolygon, NewCoord
    MsgBox "SelPoly.count: " & SelPoly.count
                If SelPoly.count > 1 Then
                   Set circleObj = ThisDrawing.ModelSpace.AddCircle(cen, 5)
                   circleObj.Color = acGreen
                End If
               ' Set plineObj = ThisDrawing.ModelSpace.AddPolyline(NewCoord)
                Set sset = ThisDrawing.ActiveSelectionSet
                ThisDrawing.SelectionSets.Item("SelP0").Delete
            Next

        End If
     Next
  Next
xxx:

    ThisDrawing.SelectionSets.Item("SS1").Delete

End Sub