自己写的一个多边形选择的例子
Sub selecebypoly()Dim acaddoc As AcadDocument
Dim k As Integer, i As Integer
Dim pointarrays() As Double
Dim retent As Object
Dim tpolyline As AcadLWPolyline
Dim sel1 As AcadSelectionSet
On Error Resume Next
Set acaddoc = ThisDrawing
Set sel1 = acaddoc.SelectionSets("zjsel")
If Err Then
Err.Clear
Set sel1 = acaddoc.SelectionSets.Add("zjsel")
End If
sel1.Clear
Set retent = getneedobject(acaddoc)'获得多边形
If retent.ObjectName = "AcDbPolyline" Then
Set tpolyline = retent
Else
End
End If
k = UBound(tpolyline.Coordinates)
k1 = (k + 1) * 1.5
ReDim pointarrays(0 To k1 - 1)
For i = 0 To k1 / 3 - 1 Step 1 '把坐标赋值给数组
pointarrays(i * 3) = tpolyline.Coordinates(i * 2)
pointarrays(i * 3 + 1) = tpolyline.Coordinates(i * 2 + 1)
pointarrays(i * 3 + 2) = 0
Next
sel1.SelectByPolygon acSelectionSetWindowPolygon, pointarrays
MsgBox sel1.Count
End Sub
Function getneedobject(acaddoc As AcadDocument) As Object
On Error Resume Next
Dim retent As Object
Dim pnt As Variant
acaddoc.Utility.GetEntity retent, ont, "选择一个闭合多边形"
Dim errnum As Integer
errnum = 0
While Err
Err.Clear
errnum = errnum + 1
If errnum < 3 Then
acaddoc.Utility.GetEntity retent, ont, "选择一个闭合多边形"
Else
End
End If
Wend
Set getneedobject = retent
End Function
页:
[1]