[分享][原创]使用AutoCAD的SelectByPolygon方法创建选择集
本帖最后由 作者 于 2010-5-22 16:37:51 编辑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 应该用代码配合说明,否则光贴代码,大家不知道你在干吗. 楼主编这个很好用，简洁、严谨，支持一下！
页:
[1]