WWWDONG 发表于 2003-11-11 14:56:00

[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



该段程序为何无法执行

mccad 发表于 2003-11-11 19:35:00

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

WWWDONG 发表于 2003-11-12 09:41:00

问题解决
页: [1]
查看完整版本: [VBA]请斑竹看看,有何问题?