如何创建选择集，选择闭合的多段线？

fengxue007

rt，谢谢！

robbin840311

LZ，代码如下，请试运行，运行过程ClosedLwpSelSet

Option Explicit

'创建选择闭合多段线的选择集
Public Sub ClosedLwpSelSet()
  Dim pClosedLwpSelSet As AcadSelectionSet
  Set pClosedLwpSelSet = CreateSelectionSet
 
  Dim n As Integer
  n = ThisDrawing.ModelSpace.Count - 1
  Dim m As Integer   '记录闭合多段线
  m = 0

  Dim pLwpObj() As AcadLWPolyline
  '得到图形中有多少个闭合的多段线
  Dim I As Integer
  For I = 0 To n
    If TypeOf ThisDrawing.ModelSpace.Item(I) Is AcadLWPolyline Then  '是多段线
      If ThisDrawing.ModelSpace.Item(I).Closed = True Then           '多段线是闭合的
        ReDim Preserve pLwpObj(m) As AcadLWPolyline                  '重新定义数组
        Set pLwpObj(m) = ThisDrawing.ModelSpace.Item(I)
        m = m + 1
      End If
    End If
  Next I

  pClosedLwpSelSet.AddItems pLwpObj               '生成闭合多段线的选择集
 
End Sub

'创建选择集的函数
Public Function CreateSelectionSet(Optional ssName As String = "ss") As AcadSelectionSet

    Dim ss As AcadSelectionSet
    On Error Resume Next
    Set ss = ThisDrawing.SelectionSets(ssName)
    If Err Then Set ss = ThisDrawing.SelectionSets.Add(ssName)
    ss.Clear
    Set CreateSelectionSet = ss

End Function

fengxue007

谢谢你了！

我在版上看到有人说用70组码＝1选择封闭多段线，我已经用这种方法选择了！

代码如下：

    Dim sset As AcadSelectionSet
    Dim fType(0 To 1) As Integer
    Dim fData(0 To 1) As Variant
    fType(0) = 0: fData(0) = "*Polyline"
    fType(2) = 70: fData(2) = 1
   
    If Not IsNull(ThisDrawing.SelectionSets.Item("pl")) Then
       Set sset = ThisDrawing.SelectionSets.Item("pl")
       sset.Delete
    End If
    Set sset = ThisDrawing.SelectionSets.Add("pl")
    sset.SelectOnScreen fType, fData

robbin840311

呵呵，那这种方法就是最好的方法啦，学习了！谢谢分享！