[求助]：VBA中选择集问题

laoxie_1983

我要选择封闭多义线内的实体，点集已经构建好了用acSelectionSetWindowPolygon总是选择不到实体。 zjxzj.SelectByPolygon acSelectionSetWindowPolygon, zb, groupCode, dataCode’这里zjxzj总是空的。
还请高手多多指点。
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总是空的。
    'zjxzj.SelectByPolygon acSelectionSetWindowPolygon, pointsArray, groupCode, dataCode
  jfh = "320506" + zjxzj.Item(0).TextString '
  '以上提取街坊坐标和街坊号
tqjfh = jfh
End Function