[分享][原创]使用AutoCAD的SelectByPolygon方法创建选择集

wylong

2. Function TestSelectByPoly() As AcadSelectionSet
3.     ' 安全创建选择集
4.     On Error Resume Next
5.     Dim SSet As AcadSelectionSet
6.     If Not IsNull(ThisDrawing.SelectionSets.Item("Example")) Then
7.         Set SSet = ThisDrawing.SelectionSets.Item("Example")
8.         SSet.Delete
9.     End If
10.     Set SSet = ThisDrawing.SelectionSets.Add("Example")
11.      
12.     ' 测试多段线作为选择边界
13.     Dim objSelect As AcadLWPolyline
14.     Dim ptPick As Variant
15.     ThisDrawing.Utility.GetEntity objSelect, ptPick, vbLf & "请选择作为边界的多段线："
16.     If (objSelect Is Nothing) Then Exit Function
17.     If objSelect.ObjectName = "AcDbPolyline" Then
18.         If objSelect.Closed = False Then
19.             MsgBox "作为边界的多段线不闭合！"
20.             Exit Function
21.         Else
22.             Dim PointArrs() As Double
23.             ReDim PointArrs((UBound(objSelect.Coordinates) + 1) * 3 / 2 - 1) As Double
24.             Dim i As Integer
25.             For i = 0 To ((UBound(objSelect.Coordinates) + 1) / 2 - 1)
26.                 PointArrs(3 * i) = objSelect.Coordinates(2 * i)
27.                 PointArrs(3 * i + 1) = objSelect.Coordinates(2 * i + 1)
28.                 PointArrs(3 * i + 2) = 0
29.             Next i
30.             
31.             SSet.SelectByPolygon acSelectionSetWindowPolygon, PointArrs '建立线内的选择集
32.         End If
33.     Else
34.         MsgBox "你选择的不是多段线！", vbInformation + vbOKOnly
35.         Exit Function
36.     End If
37.      
38.     Set TestSelectByPoly = SSet
39. End Function

Function TestSelectByPoly() As AcadSelectionSet     ' 安全创建选择集     On Error Resume Next     Dim SSet As AcadSelectionSet     If Not IsNull(ThisDrawing.SelectionSets.Item("Example")) Then         Set SSet = ThisDrawing.SelectionSets.Item("Example")         SSet.Delete     End If     Set SSet = ThisDrawing.SelectionSets.Add("Example")           ' 测试多段线作为选择边界     Dim objSelect As AcadLWPolyline     Dim ptPick As Variant     ThisDrawing.Utility.GetEntity objSelect, ptPick, vbLf & "请选择作为边界的多段线："     If (objSelect Is Nothing) Then Exit Function     If objSelect.ObjectName = "AcDbPolyline" Then         If objSelect.Closed = False Then             MsgBox "作为边界的多段线不闭合！"             Exit Function         Else             Dim PointArrs() As Double             ReDim PointArrs((UBound(objSelect.Coordinates) + 1) * 3 / 2 - 1) As Double             Dim i As Integer             For i = 0 To ((UBound(objSelect.Coordinates) + 1) / 2 - 1)                 PointArrs(3 * i) = objSelect.Coordinates(2 * i)                 PointArrs(3 * i + 1) = objSelect.Coordinates(2 * i + 1)                 PointArrs(3 * i + 2) = 0             Next i                          SSet.SelectByPolygon acSelectionSetWindowPolygon, PointArrs '建立线内的选择集         End If     Else         MsgBox "你选择的不是多段线！", vbInformation + vbOKOnly         Exit Function     End If           Set TestSelectByPoly = SSet End Function

tzraeq

应该用代码配合说明,否则光贴代码,大家不知道你在干吗.

chengaokkk

楼主编这个很好用，简洁、严谨，支持一下！