请看看这个程序到底有什么问题呢？
本帖最后由 作者 于 2003-6-7 0:20:51 编辑Sub a() '选择多边形里面的物体
Set sel1 = acaddoc.SelectionSets.Add("zjsel")
Dim mode As Integer
Dim pointarrays() As Variant
Dim tpolyline As AcadLWPolyline
On Error Resume Next
Dim retent As Object
Dim pnt As Variant
acaddoc.Utility.GetEntity retent, ont, "选择一个闭合多边形"
While Err
Err.Clear
acaddoc.Utility.GetEntity retent, ont, "选择一个闭合多边形"
Wend
If retent.ObjectName = "AcDbPolyline" Then
Set tpolyline = retent
Else
Exit Sub
End If
Dim k As Integer, i As Integer
k = UBound(tpolyline.Coordinates)
ReDim pointarrays(0 To k) As Variant
For i = 0 To k Step 1 '把坐标赋值给数组
pointarrays(i) = tpolyline.Coordinates(i)
Next
Call sel1.SelectByPolygon(acSelectionSetCrossingPolygon, pointarrays)
sel1.Highlight (True)
MsgBox sel1.Count
End Sub
奇怪，以上程序为什么选不到用pline画的闭合多边形里面的物体呢？sel1.Count总是等于0???
注意如果对象为优化多段线，则每个顶点为二维点，而选择方式中需要的是三维点
但把程序该成这样也不行啊！请帮我看看到底是什么问题呢
本帖最后由 作者 于 2003-6-7 18:23:22 编辑请看看这个程序到底有什么问题呢？
Sub a() '选择多边形里面的物体
Set sel1 = acaddoc.SelectionSets.Add("zjsel")
Dim mode As Integer
Dim pointarrays() As Variant
Dim tpolyline As AcadLWPolyline
On Error Resume Next
Dim retent As Object
Dim pnt As Variant
acaddoc.Utility.GetEntity retent, ont, "选择一个闭合多边形"
While Err
Err.Clear
acaddoc.Utility.GetEntity retent, ont, "选择一个闭合多边形"
Wend
If retent.ObjectName = "AcDbPolyline" Then
Set tpolyline = retent
Else
Exit Sub
End If
Dim k As Integer, i As Integer
k = UBound(tpolyline.Coordinates)
k1 = (k + 1) * 1.5
ReDim pointarrays(0 To k1-1) As Variant
For i = 0 To k1 / 3 Step 1 '把坐标赋值给数组
pointarrays(i * 3) = tpolyline.Coordinates(i * 2)
pointarrays(i * 3 + 1) = tpolyline.Coordinates(i * 2 + 1)
pointarrays(i * 3 + 2) = 0
Next
Call sel1.SelectByPolygon(acSelectionSetCrossingPolygon, pointarrays)
sel1.Highlight (True)
MsgBox sel1.Count
End Sub
结果还是sel1.Count总是等于0???
还有，我想问问优化多段线和一般的多段线有什么不同呢？
有三个地方有问题
1.点列表应该是双精度数组，而不能为变体。所以必须这样定义：Dim PointArrays() As Double
2.数组重新定义时不可改变数组的类型，所以重新定义时应该这样写：
ReDim PointArrays(0 To k1 - 1)
3.通过循环来定义数组中的值时有超界问题，应该这样：
For i = 0 To k1 / 3 - 1 Step 1
改过后应该可以运行正常。
问题解决了，非常感谢！
页:
[1]