社区 › VB › [VBA]请看我的 SelectByPolygon acSelectionSetCrossingPolygon 不对了

arden 发表于 2006-5-10 15:55:00

[VBA]请看我的 SelectByPolygon acSelectionSetCrossingPolygon 不对了

请大家看一下如下程序,在一幅图的多数地方选择都是正确的,我发现有一个多边形选不到其里面的物体(看付图):
Sub gHH()
Dim selobj As Object
ThisDrawing.Utility.GetEntity selobj, basePoint, "请选择线："
SelObjByPoly selobj
End Sub
Function SelObjByPoly(Ent As AcadEntity) As AcadSelectionSet
    Dim Coord As Variant
    Dim CoordCount As Integer
    Dim NewCoord() As Double
    Dim SelPoly As AcadSelectionSet
    Dim minpnt As Variant '对象边框最小点坐标
    Dim maxpnt As Variant '对象边框最大点坐标
    Dim zminpnt(0 To 2) As Double '不闭合对象的缩放点左下角点坐标
    Dim zmaxpnt(0 To 2) As Double '不闭合对象的缩放点右上角点坐标
   
      ThisDrawing.Layers.Item("SXD").LayerOn = True
      Ent.GetBoundingBox minpnt, maxpnt
          zminpnt(0) = minpnt(0) ' - 800
          zminpnt(1) = minpnt(1) '- 800
          zminpnt(2) = 0
          zmaxpnt(0) = maxpnt(0) '+ 800
          zmaxpnt(1) = maxpnt(1) '+ 800
          zmaxpnt(2) = 0
      ThisDrawing.Application.ZoomWindow zminpnt, zmaxpnt
      On Error GoTo Err1:
      Set SelPoly = ThisDrawing.SelectionSets.Add("SelP")
      
      If TypeName(Ent) = "IAcadLWPolyline" Then
               Coord = Ent.Coordinates '获取顶点坐标数组
               CoordCount = (UBound(Coord) + 1) / 2 '顶点数
               '定义新的顶点坐标数组
               ReDim NewCoord(0 To (3 * CoordCount - 1)) As Double
               For j = 0 To UBound(Coord) - 1 Step 2
                     NewCoord((3 * j) / 2) = Coord(j)
                     NewCoord((3 * j) / 2 + 1) = Coord(j + 1)
                     NewCoord((3 * j) / 2 + 2) = 0
               Next j
      ElseIf TypeName(Ent) = "IAcadPolyline" Then
               Coord = Ent.Coordinates
               CoordCount = (UBound(Coord) + 1) / 3
               ReDim NewCoord(0 To UBound(Coord)) As Double
               For j = 0 To UBound(Coord) - 1
                     NewCoord(j) = Coord(j)
                     NewCoord(j) = Coord(j)
                     NewCoord(j) = Coord(j)
               Next j
         
      End If
      SelPoly.SelectByPolygon acSelectionSetCrossingPolygon, NewCoord
      A = SelPoly.Count '个数为0
      Set SelObjByPoly = SelPoly
      ZoomPrevious
Exit Function
Err1:
    ThisDrawing.SelectionSets.Item("SelP").Delete
    Resume
End Function
**** Hidden Message *****

arden 发表于 2006-5-10 16:14:00

我反复试了很多次,有几次得到了SelPoly.Count 为7,但多数时候为0,具体哪种情况下得到了7也不搞明白

mccad 发表于 2006-5-11 20:52:00

象这样的程序，你可以在调试时使用debug.print来打印出点表数据，看看数据有没有问题。

nxy_918 发表于 2006-5-12 08:28:00

点表数据？是指什么？mccad

arden 发表于 2006-5-14 08:27:00

点列表如下:好象看不出有问题.在我的图内还有这样选不到内部的多段线,我估计会不会与多段线围成的形状有关系,好象复杂一点的都要出问题复制代码

mccad 发表于 2006-5-14 09:27:00

注意，选择框点表不能自相交。

arden 发表于 2006-5-14 17:38:00

我刚刚又试了一下,这下每次运行都能得到SelPoly.Count =7,真是奇怪,什么都没改啊有时正确有时又不正确,这样的程序谁敢用?拜托各位大侠帮忙找一下原因．
还有就是boundary命令用起也是头痛，同样的图形有时能生成边界有时又不能生成边界。不知大家能不能自己搞一个类似boundary命令功能来生成边界的程序（可能比较困难啊），这样的算法有么？

dchlmz 发表于 2006-5-16 18:26:00

arden
你是怎么解决使用SelectByPolygon acSelectionSetWindowPolygon时，当两边界重合时的问题？

lichh_2003 发表于 2006-5-16 21:39:00

我的程序也有这个问题。
当图形简单、小时没有任何的错误出现
但当图形较大且复杂时出现这个错误，选不到图元，有时候能选到但这样的不多。
我怀疑是不是CAD提供的函数不稳定，有错误？？？？？？？？

yadg0 发表于 2007-7-13 11:20:00

dwg文件刚被打开时也选择不到对象，有没有人碰到这个问题啊?怎么解决的?

查看完整版本: [VBA]请看我的 SelectByPolygon acSelectionSetCrossingPolygon 不对了