阅读:1106回复:2
请教:跨图层访问数据的问题
代码如下:
Option Explicit Dim dc As New MapObjects2.DataConnection Dim lyr As New MapObjects2.MapLayer '9个图层的纪录集 Dim rs1 As MapObjects2.Recordset Dim rs2 As MapObjects2.Recordset Dim rs3 As MapObjects2.Recordset Dim rs4 As MapObjects2.Recordset Dim rs5 As MapObjects2.Recordset Dim rs6 As MapObjects2.Recordset Dim rs7 As MapObjects2.Recordset Dim rs8 As MapObjects2.Recordset Dim rs9 As MapObjects2.Recordset Private Sub cmdExit_Click() End End Sub '为9个图层装载Coverage文件 Private Sub cmdLoad_Click() dc.Database = "[ARC]D:\agrgis\maps\GSFXYJ" If dc.Connect Then Set lyr.GeoDataset = dc.FindGeoDataset("yj0101.pat") Map1.Layers.Add lyr Text1.Text = "yj0101" Else MsgBox "Connection failed" End If dc.Database = "[ARC]D:\agrgis\maps\gsfxJS" If dc.Connect Then Set lyr.GeoDataset = dc.FindGeoDataset("js0101.pat") Map1.Layers.Add lyr Text2.Text = "js0101" Else MsgBox "Connection failed" End If dc.Database = "[ARC]D:\agrgis\maps\gsfxJW" If dc.Connect Then Set lyr.GeoDataset = dc.FindGeoDataset("jw0101.pat") Map1.Layers.Add lyr Text3.Text = "jw0101" Else MsgBox "Connection failed" End If dc.Database = "[ARC]D:\agrgis\maps\GSFXKT" If dc.Connect Then Set lyr.GeoDataset = dc.FindGeoDataset("kt0101.pat") Map1.Layers.Add lyr Text4.Text = "kt0101" Else MsgBox "Connection failed" End If dc.Database = "[ARC]D:\agrgis\maps\GSFXNT" If dc.Connect Then Set lyr.GeoDataset = dc.FindGeoDataset("nt0101.pat") Map1.Layers.Add lyr Text5.Text = "nt0101" Else MsgBox "Connection failed" End If dc.Database = "[ARC]D:\agrgis\maps\GSFXPT" If dc.Connect Then Set lyr.GeoDataset = dc.FindGeoDataset("pt0101.pat") Map1.Layers.Add lyr Text6.Text = "pt0101" Else MsgBox "Connection failed" End If dc.Database = "[ARC]d:\agrgis\maps\GSFXTR" If dc.Connect Then Set lyr.GeoDataset = dc.FindGeoDataset("tr0101.pat") Map1.Layers.Add lyr Text7.Text = "tr0101" Else MsgBox "Connection failed" End If dc.Database = "[ARC]D:\agrgis\maps\gsfxdx" If dc.Connect Then Set lyr.GeoDataset = dc.FindGeoDataset("dx0101.pat") Map1.Layers.Add lyr Text8.Text = "dx0101" Else MsgBox "Connection failed" End If dc.Database = "[ARC]D:\agrgis\maps\GSFXXJ" If Not dc.Connect Then End Set lyr.GeoDataset = dc.FindGeoDataset("xj0101.pat") Map1.Layers.Add lyr Text9.Text = "xj0101" Set lyr = Map1.Layers("xj0101.pat") lyr.Symbol.Style = moTransparentFill ' lyr.Symbol.OutlineColor = moRed lyr.Symbol.Outline = True lyr.Symbol.OutlineColor = moRed Set lyr.Renderer = New LabelRenderer 'lyr.Renderer.DrawBackground = False lyr.Renderer.Field = "NAME" Set sym = lyr.Renderer.Symbol(0) Dim txtFont As New StdFont txtFont.Name = "Times" sym.Font = txtFont sym.Color = moRed End Sub Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) Dim Loc As New MapObjects2.Point If Form1.ScaleMode <> vbTwips Then x = Form1.ScaleX(x, vbTwips, Form1.ScaleMode) y = Form1.ScaleY(y, vbTwips, Form1.ScaleMode) End If '获取鼠标单击的点 Set Loc = Map1.ToMapPoint(x, y) '获取该点在xj0101.pat图层中的相应属性数据 Set rs1 = Map1.Layers("xj0101.pat").SearchShape(Loc, moPointInPolygon, "") Text1.Text = rs1.Fields("NAME").Value '获取该点在dx0101.pat图层中的相应属性数据 Set rs2 = Map1.Layers("dx0101.pat").SearchShape(Loc, moPointInPolygon, "") Text2.Text = rs2.Fields("VALUE").Value '获取该点在tr0101.pat图层中的相应属性数据 Set rs3 = Map1.Layers("tr0101.pat").SearchShape(Loc, moPointInPolygon, "") Text3.Text = rs3.Fields("SOIL-TYPE").Value '获取该点在pt0101.pat图层中的相应属性数据 Set rs4 = Map1.Layers("pt0101.pat").SearchShape(Loc, moPointInPolygon, "") Text4.Text = rs4.Fields("CONTENT").Value Set rs5 = Map1.Layers("nt0101.pat").SearchShape(Loc, moPointInPolygon, "") Text5.Text = rs5.Fields("CONTENT").Value Set rs6 = Map1.Layers("kt0101.pat").SearchShape(Loc, moPointInPolygon, "") Text6.Text = rs6.Fields("CONTENT").Value Set rs7 = Map1.Layers("jw0101.pat").SearchShape(Loc, moPointInPolygon, "") Text7.Text = rs7.Fields("VALUE").Value Set rs8 = Map1.Layers("js0101.pat").SearchShape(Loc, moPointInPolygon, "") Text8.Text = rs8.Fields("VALUE").Value Set rs9 = Map1.Layers("yj0101.pat").SearchShape(Loc, moPointInPolygon, "") Text9.Text = rs9.Fields("CONTENT").Value End Sub 运行出错提示: Run time error "91:" Object variable or With block variable not set 请教如何改正? 不胜感激! (各图层确已加载上了) |
|
2楼#
发布于:2004-01-07 19:42
是的
|
|
3楼#
发布于:2004-01-07 19:53
贴个例子了
vb代码和数据 <a href="attachment/20041719524743258.rar">20041719524743258.rar</a> Option Explicit Private dc As New MapObjects2.DataConnection Private mlyr As New MapObjects2.MapLayer Private shpSelected As Object Private symSelected As New MapObjects2.Symbol Private Sub Form_Load() 'Load counties layer dc.Database = App.Path dc.Connect Set mlyr.GeoDataset = dc.FindGeoDataset("counties") mlyr.Symbol.Color = moLightGray Map1.Layers.Add mlyr 'Setup selected symbol With symSelected .SymbolType = moFillSymbol .Style = moSolidFill .Color = moYellow End With End Sub Private Sub Map1_AfterLayerDraw(ByVal index As Integer, ByVal canceled As Boolean, ByVal hDC As stdole.OLE_HANDLE) 'If the "counties" layer just drew, and if there is a selected 'shape, then draw it. If there is not a selected shape, then 'clear the form labels. If Map1.Layers(index).Name = "counties" Then If Not shpSelected Is Nothing Then Map1.DrawShape shpSelected, symSelected Else Label2(1).Caption = vbNullString Label2(3).Caption = vbNullString End If End If End Sub Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 'Convert mouse click from control coordinates 'into map coordinates Dim pt As MapObjects2.Point Set pt = Map1.ToMapPoint(X, Y) 'Select features clicked on. Return a Recordset object. Dim recs As MapObjects2.Recordset Set recs = mlyr.SearchShape(pt, moPointInPolygon, "") If recs Is Nothing Then Set shpSelected = Nothing Exit Sub End If If recs.Count > 0 Then 'Get the county name and state name out of the 'returned recordset. Put them into the form labels Label2(1).Caption = recs.Fields("STATE_NAME").Value Label2(3).Caption = recs.Fields("CNTY_NAME").Value 'Get the selected shape out of the returned Recordset Set shpSelected = recs.Fields("Shape").Value 'Redraw the map, which triggers AfterLayerDraw. Map1.Refresh Else Set shpSelected = Nothing End If Map1.Refresh End Sub |
|
4楼#
发布于:2004-01-07 19:53
如果需要图层关联,你可以查看论坛精华区和其他贴,有发过
|
|
5楼#
发布于:2004-01-08 08:40
版主有无多个图层的例子,单个图层的我知道了,现在困惑我的是多个图层的同时查询,还请版主贴个这样的例子,或根据我上面的代码指点一二。 多谢版主及各位高手!
|
|