怪事情，哪位知道，选择集？

nxy_918

用下面程序，进行选择，不知道为什么，这个图形里的这几条线，居然选不中，很是不解，哪位高手帮我看看，谢谢！
注意：选择裁切线要选外围的l3DPolyline白色多边形

2. Sub Test_cut()
3. Dim ss As AcadSelectionSet
4. Dim obj As AcadEntity
5. Dim pArray() As Double
6. 'Dim pArray As Variant
7. Dim basePnt As Variant
8. Dim i As Integer
9. 'Dim groupCode As Variant, dataCode As Variant
10. Dim Coord As Variant
12. On Error Resume Next
13. 'ThisDrawing.Utility.Prompt vbCr & "选择要裁切范围线："
14. ThisDrawing.Utility.GetEntity obj, basePnt, "选择要裁切范围线:"
15. If Err Then
16.    Exit Sub
17. Else
18.          Do While ThisDrawing.SelectionSets.count > 0
19.             ThisDrawing.SelectionSets.Item(0).Delete
20.          Loop
21.          Set ss = ThisDrawing.SelectionSets.Add("tt")
22.         Coord = obj.Coordinates '获取顶点坐标数组
23.         ReDim pArray(0 To UBound(Coord)) As Double
24.         For i = 0 To UBound(Coord)
25.             pArray(i) = Coord(i)
26.         Next i
27.         Call ss.SelectByPolygon(acSelectionSetFence, pArray)
28.         If ss.count > 0 Then
29.         Dim removeObjects(0 To 0) As AcadEntity
30.           Set removeObjects(0) = obj
31.            ss.RemoveItems removeObjects
32.            For i = 0 To ss.count - 1
33.              ss.Item(i).Highlight True
34.            Next
35.         End If
36. End If
37. End Sub

Sub Test_cut() Dim ss As AcadSelectionSet Dim obj As AcadEntity Dim pArray() As Double 'Dim pArray As Variant Dim basePnt As Variant Dim i As Integer 'Dim groupCode As Variant, dataCode As Variant Dim Coord As Variant On Error Resume Next 'ThisDrawing.Utility.Prompt vbCr & "选择要裁切范围线：" ThisDrawing.Utility.GetEntity obj, basePnt, "选择要裁切范围线:" If Err Then    Exit Sub Else          Do While ThisDrawing.SelectionSets.count > 0             ThisDrawing.SelectionSets.Item(0).Delete          Loop          Set ss = ThisDrawing.SelectionSets.Add("tt")         Coord = obj.Coordinates '获取顶点坐标数组         ReDim pArray(0 To UBound(Coord)) As Double         For i = 0 To UBound(Coord)             pArray(i) = Coord(i)         Next i         Call ss.SelectByPolygon(acSelectionSetFence, pArray)         If ss.count > 0 Then         Dim removeObjects(0 To 0) As AcadEntity           Set removeObjects(0) = obj            ss.RemoveItems removeObjects            For i = 0 To ss.count - 1              ss.Item(i).Highlight True            Next         End If End If End Sub

nxy_918

图形传不上去，没办法

xinghesnak

楼上的，你的程序有问题，通过坐标选择的时候应该输入三维坐标变量，由Pline的Coordinates 属性得到是二维坐标，你改成这样就行了

。。。。。。

 Set ss = ThisDrawing.SelectionSets.Add("tt")
         Coord = obj.Coordinates '获取顶点坐标数组
         ReDim pArray(0 To UBound(Coord) + (UBound(Coord) + 1) / 2) As Double
         Dim j As Integer
         For i = 0 To UBound(Coord)
             pArray(i) = Coord(i)
         Next i
         For i = 1 To (UBound(Coord) + 1) / 2
            For j = UBound(pArray) To i * 3 - 1 Step -1
                pArray(j) = pArray(j - 1)
            Next
            pArray(i * 3 - 1) = obj.Elevation
         Next
         Call ss.SelectByPolygon(acSelectionSetFence, pArray)

。。。。。。

这样做就是人为的增加一个Z轴坐标值。。。。。。^_^