zyj_iim
路人甲
路人甲
  • 注册日期2003-12-06
  • 发帖数137
  • QQ
  • 铜币264枚
  • 威望0点
  • 贡献值0点
  • 银元0个
阅读:1106回复:2

请教:跨图层访问数据的问题

楼主#
更多 发布于:2004-01-07 15:13
代码如下:

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
 
 请教如何改正?

    不胜感激!

(各图层确已加载上了)
喜欢0 评分0
gis1117
  • 注册日期
  • 发帖数
  • QQ
  • 铜币
  • 威望
  • 贡献值
  • 银元
1楼#
发布于:2004-01-07 16:08
你要做的是定做identify的功能吗?
举报 回复(0) 喜欢(0)     评分
zyj_iim
路人甲
路人甲
  • 注册日期2003-12-06
  • 发帖数137
  • QQ
  • 铜币264枚
  • 威望0点
  • 贡献值0点
  • 银元0个
2楼#
发布于:2004-01-07 19:42
是的
举报 回复(0) 喜欢(0)     评分
gis1117
  • 注册日期
  • 发帖数
  • QQ
  • 铜币
  • 威望
  • 贡献值
  • 银元
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
举报 回复(0) 喜欢(0)     评分
gis1117
  • 注册日期
  • 发帖数
  • QQ
  • 铜币
  • 威望
  • 贡献值
  • 银元
4楼#
发布于:2004-01-07 19:53
如果需要图层关联,你可以查看论坛精华区和其他贴,有发过
举报 回复(0) 喜欢(0)     评分
zyj_iim
路人甲
路人甲
  • 注册日期2003-12-06
  • 发帖数137
  • QQ
  • 铜币264枚
  • 威望0点
  • 贡献值0点
  • 银元0个
5楼#
发布于:2004-01-08 08:40
版主有无多个图层的例子,单个图层的我知道了,现在困惑我的是多个图层的同时查询,还请版主贴个这样的例子,或根据我上面的代码指点一二。 多谢版主及各位高手!
举报 回复(0) 喜欢(0)     评分
gis1117
  • 注册日期
  • 发帖数
  • QQ
  • 铜币
  • 威望
  • 贡献值
  • 银元
6楼#
发布于:2004-01-08 13:26
在图层间循环就行了
举报 回复(0) 喜欢(0)     评分
游客

返回顶部