转至繁体中文版     | 网站首页 | 图文教程 | 资源下载 | 站长博客 | 图片素材 | 武汉seo | 武汉网站优化 | 
最新公告:     敏韬网|教学资源学习资料永久免费分享站!  [mintao  2008年9月2日]        
您现在的位置: 学习笔记 >> 图文教程 >> 软件开发 >> VB.NET程序 >> 正文
mapx+vb实战摘要(四)         ★★★★

mapx+vb实战摘要(四)

作者:闵涛 文章来源:闵涛的学习笔记 点击数:606 更新时间:2009/4/23 15:43:05

12 查找图元
   mapx查找地图上的图元有多种方法

  a, FindObj.Search
    这种方法在用的时候有局限性:数据集必须要有索引,查找的字段类型不能是10进制类型(可能还有其它的类型,忘了),否则在图上找不到。

     Set FindObj = fMainForm.Map1.Layers(LayerCombo.Text).Find
    Set FindObj.FindDataset = fMainForm.Map1.DataSets(LayerCombo.Text & " dataset")
    Set FindObj.FindField = FindObj.FindDataset.Fields(FieldCombo.Text)
    Set FoundFeature = FindObj.Search(FindText.Text)

If FoundFeature.FindRC Mod 10 = 1 Or FoundFeature.FindRC Mod 10 = 2 Then       
       fMainForm.Map1.Layers(LayerCombo.Text).Selection.Add FoundFeature
        fMainForm.Map1.AutoRedraw = False
        fMainForm.Map1.CenterX = FoundFeature.CenterX
        fMainForm.Map1.CenterY = FoundFeature.CenterY
   End If

  b,SQL语句方法

Dim ftrs As MapXLib.Features
Dim lyr As Layer
Dim i As Integer

 Set lyr = fMainForm.Map1.Layers(RoadlyrName)
 Dim strs As String
 strs = Trim("路线编码 = " + Chr(34) + ComRoadID.List(ComRoadID.ListIndex) + Chr(34))‘在值前面加双引号如:ID="001",         观测点名称 like "%天平庄"
  Set ftrs = lyr.Search(strs)
  lyr.Selection.ClearSelection
 lyr.Selection.Add ftrs
 If ftrs.Count > 0 Then
 fMainForm.Map1.CenterX = ftrs.Item(1).CenterX
 fMainForm.Map1.CenterY = ftrs.Item(1).CenterY
 End If

13显示鼠标当前的经纬度
 Private Sub Map1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
      Dim MX As Double, MY As Double
      Map1.ConvertCoord x, y, MX, MY, 1
   
        Text1.Item(1).Caption = "当前位置"
        Text1.Item(2).Caption = "东经 " & Format(MX, "###0.0000") + ",北纬 " + Format(MY, "###0.0000")               
        Text1.Item(3).Caption = " 当前图层"
        Text1.Item(4).Caption = Map1.Layers(1).Name
End Sub

14自动滚屏
 Private Sub Map1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
 If mnuMoveCenter.Checked = True Then
    If x > Map1.MapScreenWidth - 10 Then
   
    Map1.CenterX = Map1.CenterX + 0.05
   
    Map1.Refresh
   
    Else
   
    If x < 10 Then
   
    Map1.CenterX = Map1.CenterX - 0.05
   
    Map1.Refresh
   
    Else
   
    If y > Map1.MapScreenHeight - 10 Then
   
    Map1.CenterY = Map1.CenterY - 0.05
   
    Map1.Refresh
   
    Else
   
    If y < 10 Then
   
    Map1.CenterY = Map1.CenterY + 0.05
   
    Map1.Refresh
   
    End If
   
    End If
   
    End If
   
    End If
End If
 End Sub


15测距和测面积
Private Sub Form_Load()
  Map1.CreateCustomTool PolyRulerToolID, miToolTypePoly, miSizeAllCursor
    Map1.CreateCustomTool PolyAreaToolID, miToolTypePolygon, miSelectRegionMinusCursor
End Sub


 Private Sub Map1_PolyToolUsed(ByVal ToolNum As Integer, ByVal flags As Long, ByVal Points As Object, ByVal bShift As Boolean, ByVal bCtrl As Boolean, EnableDefault As Boolean)
    If ToolNum = PolyRulerToolID Then
        Dim i As Integer
        Dim DistanceSoFar As Double
        Map1.MapUnit = RulerUnit
        DistanceSoFar = 0#
        If Points.Count > 1 Then
            For i = 2 To Points.Count
                DistanceSoFar = DistanceSoFar + Map1.Distance(Points.Item(i).x, Points.Item(i).y, Points.Item(i - 1).x, Points.Item(i - 1).y)
            Next
        End If
        If flags = miPolyToolEnd Then
            ''''First, clear the status bar
           
            Text1.Item(4).Caption = ""
            MsgBox "距离: " & DistanceSoFar & " " & RulerUnitString
        Else
            Text1.Item(3).Caption = "距离"
             Text1.Item(4).Caption = DistanceSoFar & " " & RulerUnitString
        End If
    End If
    If ToolNum = PolyAreaToolID Then
    ''''面积
    
     Map1.AreaUnit = miUnitSquareKilometer
    On Error Resume Next
    Dim apolygoN As New MapXLib.Feature
    Dim ax As Double
    If (Points.Count > 2) Then
    Set apolygoN = New Feature
    Set apolygoN = Map1.FeatureFactory.CreateRegion(Points)
    ax = apolygoN.Area
    MsgBox "面积: " & ax
    End If
       
End If

End Sub


没有相关教程
教程录入:mintao    责任编辑:mintao 
  • 上一篇教程:

  • 下一篇教程:
  • 【字体: 】【发表评论】【加入收藏】【告诉好友】【打印此文】【关闭窗口
      注:本站部分文章源于互联网,版权归原作者所有!如有侵权,请原作者与本站联系,本站将立即删除! 本站文章除特别注明外均可转载,但需注明出处! [MinTao学以致用网]
      网友评论:(只显示最新10条。评论内容只代表网友观点,与本站立场无关!)

    同类栏目
    · C语言系列  · VB.NET程序
    · JAVA开发  · Delphi程序
    · 脚本语言
    更多内容
    热门推荐 更多内容
  • 没有教程
  • 赞助链接
    更多内容
    闵涛博文 更多关于武汉SEO的内容
    500 - 内部服务器错误。

    500 - 内部服务器错误。

    您查找的资源存在问题,因而无法显示。

    | 设为首页 |加入收藏 | 联系站长 | 友情链接 | 版权申明 | 广告服务
    MinTao学以致用网

    Copyright @ 2007-2012 敏韬网(敏而好学,文韬武略--MinTao.Net)(学习笔记) Inc All Rights Reserved.
    闵涛 投放广告、内容合作请Q我! E_mail:admin@mintao.net(欢迎提供学习资源)

    站长:MinTao ICP备案号:鄂ICP备11006601号-18

    闵涛站盟:医药大全-武穴网A打造BCD……
    咸宁网络警察报警平台