[求助]VBA选择集问题(急）
各位高手：我要选择一封闭多义线内的图元，构建好坐标集后有时能选择到实体有时候选择不到时怎么回事？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
不是屏幕选择。zb是一个坐标集，我要选择zb构成的多义线内的图元。总是提示“参数 pointslist(位于selectbypolygon)中无效。我看过书了坐标是我写的格式的呀！怎么回事呢？还请各位大虾帮帮忙。 高手们：帮我看看到底怎么回事吧？就被这点给挡住了。下不下去了！
麻烦大家了！
有时选不到。你在选择前用下zoom all。如果出错看看zb是不是三维坐标。
我用zoom all了，zb就是三维坐标。今天在单位里运行就没问题的。真的很奇怪！ 问题终于自己解决了。
页:
[1]