如何创建选择集，选择闭合的多段线？
rt，谢谢！ <p>LZ，代码如下，请试运行，运行过程ClosedLwpSelSet</p><p>Option Explicit</p><p>'创建选择闭合多段线的选择集<br/>Public Sub ClosedLwpSelSet()<br/> Dim pClosedLwpSelSet As AcadSelectionSet<br/> Set pClosedLwpSelSet = CreateSelectionSet<br/> <br/> Dim n As Integer<br/> n = ThisDrawing.ModelSpace.Count - 1<br/> Dim m As Integer '记录闭合多段线<br/> m = 0</p><p> Dim pLwpObj() As AcadLWPolyline<br/> '得到图形中有多少个闭合的多段线<br/> Dim I As Integer<br/> For I = 0 To n<br/> If TypeOf ThisDrawing.ModelSpace.Item(I) Is AcadLWPolyline Then '是多段线<br/> If ThisDrawing.ModelSpace.Item(I).Closed = True Then '多段线是闭合的<br/> ReDim Preserve pLwpObj(m) As AcadLWPolyline '重新定义数组<br/> Set pLwpObj(m) = ThisDrawing.ModelSpace.Item(I)<br/> m = m + 1<br/> End If<br/> End If<br/> Next I</p><p> pClosedLwpSelSet.AddItems pLwpObj '生成闭合多段线的选择集<br/> <br/>End Sub</p><p>'创建选择集的函数<br/>Public Function CreateSelectionSet(Optional ssName As String = "ss") As AcadSelectionSet</p><p> Dim ss As AcadSelectionSet<br/> On Error Resume Next<br/> Set ss = ThisDrawing.SelectionSets(ssName)<br/> If Err Then Set ss = ThisDrawing.SelectionSets.Add(ssName)<br/> ss.Clear<br/> Set CreateSelectionSet = ss</p><p>End Function<br/></p> <p>谢谢你了！</p><p>我在版上看到有人说用70组码＝1选择封闭多段线，我已经用这种方法选择了！</p><p>代码如下：</p><p> Dim sset As AcadSelectionSet<br/> Dim fType(0 To 1) As Integer<br/> Dim fData(0 To 1) As Variant<br/> fType(0) = 0: fData(0) = "*Polyline"<br/> fType(2) = 70: fData(2) = 1<br/> <br/> If Not IsNull(ThisDrawing.SelectionSets.Item("pl")) Then<br/> Set sset = ThisDrawing.SelectionSets.Item("pl")<br/> sset.Delete<br/> End If<br/> Set sset = ThisDrawing.SelectionSets.Add("pl")<br/> sset.SelectOnScreen fType, fData<br/></p> 呵呵，那这种方法就是最好的方法啦，学习了！谢谢分享！
页:
[1]