[求助]VBA选择集问题(急）

laoxie_198

各位高手：我要选择一封闭多义线内的图元，构建好坐标集后有时能选择到实体有时候选择不到时怎么回事？lisp中用"wf"就能选中，在vba中用acSelectionSetWindowPolygon总是有问题。

请高手指点！下面是代码

Sub jhfsc() '街坊线上传到金图数据库中
 Dim cn As New ADODB.Connection
 Dim gdeo As New ADODB.Recordset
 Dim gdeov As New ADODB.Recordset
 Dim gdv3 As New ADODB.Recordset
 Dim sqllj, gdeolj, gdeovlj, gdv3lj, jfh As String
 Dim jfmj As Double '街坊面积
 Dim ftype(0 To 1) As Integer
 Dim maxvid, vid, eoid, maxeoid As Long
 Dim fdata(0 To 1) As Variant
 ftype(0) = 0: fdata(0) = "LWPOLYLINE"
 ftype(1) = 8: fdata(1) = "街坊线"
 Dim ddzb(), sjzb() As Double '顶点坐标
 Dim dds, mode As Integer
 Dim zb As Variant
 Dim ltime As Date
 sqllj = "provider=sqloledb.1;password= ;persist security info=true;user id=sa;initial catalog=wzlz ;data source=hbxx"
 cn.Open sqllj
 
  gdv3lj = "select maxvid=max(vid) from gdv3"
  gdv3.Open gdv3lj, cn, adOpenForwardOnly, adLockBatchOptimistic
  Do While Not gdv3.EOF
    maxvid = gdv3.Fields("maxvid")
    gdv3.MoveNext
  Loop
gdv3.Close

gdeolj = "select maxeoid=max(eoid) from gdeo"
gdeo.Open gdeolj, cn, adOpenForwardOnly, adLockBatchOptimistic
If Not gdeo.EOF Then
maxeoid = gdeo.Fields("maxeoid")
End If
gdeo.Close

 
 On Error Resume Next
   Dim xzj As AcadSelectionSet
   If Not IsNull(ThisDrawing.SelectionSets.Item("st")) Then
     Set xzj = ThisDrawing.SelectionSets.Item("st")
     xzj.Delete
     End If
  Set xzj = ThisDrawing.SelectionSets.Add("st") '新建选择集
  'MsgBox xzj.Name
  xzj.Select acSelectionSetAll, , , ftype, fdata '选择街坊线
  Dim ty As AcadEntity
 
  For Each ty In xzj
  Dim i As Integer
  dds = (UBound(ty.Coordinates) + 1) / 2
  zb = ty.Coordinates
  jfmj = ty.Area '街坊面积
    ReDim ddzb(dds * 3 - 1)
    ReDim sjzb(dds - 1, 1)
    For i = 0 To dds - 1
    ddzb(3 * i) = zb(2 * i) 'y
    ddzb(3 * i + 1) = zb(2 * i + 1) 'x
    ddzb(3 * i + 2) = 0
    sjzb(i, 0) = zb(2 * i)
    sjzb(i, 1) = zb(2 * i + 1)
    Next i '提取端点坐标
   
  
 jfh = tqjfh(ddzb)
 
  'gdeolj = "select * from gdeo where description=' " & jfh & "'"
  cn.Execute "insert into gdeo (eoid,description,lastuser,lastaction,synchronized,btf,lastupdatetime,area,st) values(" & maxeoid + 1 & "," & jfh & " ,"",0,1,0," & ltime & "," & jfmj & ",1"

  For i = 0 To dds - 1
  gdv3lj = "select * from gdv3 where x=" & sjzb(i, 1) & " and y= " & sjzb(i, 0) & ""
  gdv3.Open gdv3lj, cn, adOpenForwardOnly, adLockBatchOptimistic
  If Not gdv3.EOF Then
    vid = gdv3.Fields("vid")
  Else
    vid = maxvid + 1
    cn.Execute "insert into gdv3 (vid,eoid,vn,x,y,h,vsp,vxys,vhs,vc,lastupdatetime,vt) values (" & vid & ", " & maxeoid + 1 & "," & sjzb(i, 1) & "," & sjzb(i, 0) & ",0,2,1,1,0," & ltime & ",99)"
  End If
    cn.Execute "insert into gdeov (eoid,eovo,eovid) values (" & maxeoid + 1 & "," & i + 1 & "," & vid & ")"
   maxvid = maxvid + 1
 
  Next
 
 
 
  maxeoid = maxeoid + 1
  Next 'or Each ty In xzj
 
 
End Sub

Function tqjfh(zb) As String '提取街坊号
 On Error Resume Next
  Dim zjxzj As AcadSelectionSet
     If Not IsNull(ThisDrawing.SelectionSets.Item("zjst")) Then
     Set zjxzj = ThisDrawing.SelectionSets.Item("zjst")
     zjxzj.Delete
     End If
  Set zjxzj = ThisDrawing.SelectionSets.Add("zjst") '新建选择集
  ReDim gpCode(0 To 1) As Integer
    gpCode(0) = 0
    gpCode(1) = 8
    ReDim dataValue(0 To 1) As Variant
    dataValue(0) = "MTEXT"
    dataValue(1) = "街坊注记"
   
    Dim groupCode As Variant, dataCode As Variant
    groupCode = gpCode
    dataCode = dataValue
   
    zjxzj.SelectByPolygon acSelectionSetWindowPolygon, zb, groupCode, dataCode'这里总是选择不到实体。
    'zjxzj.SelectByPolygon acSelectionSetWindowPolygon, pointsArray, groupCode, dataCode
  jfh = "320506" + zjxzj.Item(0).TextString '
  '以上提取街坊坐标和街坊号
tqjfh = jfh
End Function

nigma

laoxie_198发表于2007-10-18 8:31:00各位高手：我要选择一封闭多义线内的图元，构建好坐标集后有时能选择到实体有时候选择不到时怎么回事？lisp中用\"wf\"就能选中，在vba中用acSelectionSetWindowPolygon总是有问题。.........&n

laoxie_198

不是屏幕选择。zb是一个坐标集，我要选择zb构成的多义线内的图元。总是提示“参数 pointslist(位于selectbypolygon)中无效。我看过书了坐标是我写的格式的呀！怎么回事呢？还请各位大虾帮帮忙。

laoxie_198

高手们：帮我看看到底怎么回事吧？就被这点给挡住了。下不下去了！

麻烦大家了！

fjfhgdwfn

有时选不到。你在选择前用下zoom all。如果出错看看zb是不是三维坐标。

laoxie_198

我用zoom all了，zb就是三维坐标。今天在单位里运行就没问题的。真的很奇怪！

laoxie_198

问题终于自己解决了。