[VBA]请斑竹看看,有何问题?
Public Sub test2()Dim mypline As AcadLWPolyline
Dim ss1 As AcadSelectionSet
Dim pt As Variant
Dim points As Variant
Call ThisDrawing.Utility.GetEntity(mypline, pt, "22=")
Call bulidselction(ss1, 1) '创建选择集
points = mypline.Coordinates
ss1.SelectByPolygon acSelectionSetCrossingPolygon, points
Debug.Print ss1.count
End Sub
Public Sub bulidselction(mysle As AcadSelectionSet, pp As String)
'定义名为PP的选择集,赋值于mysle,若存在则引用,不存在则创建
Dim k As Integer
Dim num As Integer
Dim aaa As Boolean
aaa = False
For k = 0 To ThisDrawing.SelectionSets.count - 1
If ThisDrawing.SelectionSets.Item(k).Name = pp Then
aaa = True
num = k
Exit For
End If
Next k
If aaa = True Then
Set mysle = ThisDrawing.SelectionSets.Item(pp)
mysle.Delete
Set mysle = ThisDrawing.SelectionSets.add(pp)
Else
Set mysle = ThisDrawing.SelectionSets.add(pp)
End If
End Sub
该段程序为何无法执行 1.创建选择集的函数也太复杂了一点吧,其实几句就可以完成的,查查以前的贴子吧。
2.优化多段线的点集是二维的,而选择集的点指需要的是三维坐标的,所以出错。
Public Sub test2()
Dim mypline As AcadLWPolyline
Dim ss1 As AcadSelectionSet
Dim pt As Variant
Dim points As Variant
Call ThisDrawing.Utility.GetEntity(mypline, pt, "22=")
Call bulidselction(ss1, 1) '创建选择集
points = mypline.Coordinates
Dim pnts() As Double
Dim i As Integer
i = (UBound(points) + 1) / 2 * 3 - 1
ReDim pnts(i)
For i = 0 To (UBound(points) + 1) / 2 - 1
pnts(i * 2 + i) = points(i * 2)
pnts(i * 2 + i + 1) = points(i * 2 + 1)
Next
ss1.SelectByPolygon acSelectionSetCrossingPolygon, pnts
Debug.Print ss1.Count
End Sub
问题解决
页:
[1]