查找最近的实体
来源:互联网 发布:大数据查询引擎 编辑:程序博客网 时间:2024/05/02 00:02
Private Sub Command1_Click()
Map1.CurrentTool = 101
End Sub
Private Sub cmdQuit_Click()
End
End Sub
Public Function Nearest(ByVal objMap As Map, ByVal strSearchLayer As String, _
ByVal dblX As Double, ByVal dblY As Double, ByVal sngRadius As Single, _
strItemName As String, X1 As Double, Y1 As Double, X2 As Double, Y2 As Double) As Integer
' Returns the name and location of the closest item from the search layer.
' objMap: the MapX object containing the search layer
' strSearchLayer: The layer being searched
' dblX,dblY: Coordinates of where to center the search
' sngRadius: the initial size ring in km MapX will select from within
' strItemName: Name of closest feature item
' x1,y1,x2,y2: Coordinates of closest feature item
Dim sngLowestDist As Single, sngTemp As Single
Dim iTimesThrough As Integer
Dim ft As New MapXlib.Feature
Dim rect As New MapXlib.Rectangle
Dim first As Integer'Select all of the objects within Radius km of dblX,Y
'If there's nothing there, double the radius and try again.
'Repeat until something is found, or we ran through this 10 times
iTimesThrough = 1
Do
'execute the SelectByRadius method of MapX
objMap.Layers(strSearchLayer).Selection.SelectByRadius dblX, dblY, sngRadius, miSelectionNew
'Double the radius for the next search (if needed)
sngRadius = sngRadius * 2
'Increment our counter
iTimesThrough = iTimesThrough + 1Loop Until objMap.Layers(strSearchLayer).Selection.Count > 0 Or iTimesThrough > 10
'Test to see if there was anything selected
If objMap.Layers(strSearchLayer).Selection.Count = 0 Then
Nearest = False
Exit Function
End If
'Find closest feature in selection collection
first = True
For Each ft In objMap.Layers(strSearchLayer).Selection
'get the distance to the selected object
sngTemp = objMap.Distance(dblX, dblY, ft.CenterX, ft.CenterY)
'is this closest so far?
If first Or (sngTemp < sngLowestDist) Then
' replace feature details
sngLowestDist = sngTemp
strItemName = ft.Name
' rect = ft.bounds
X1 = ft.Bounds.XMin
Y1 = ft.Bounds.YMin
X2 = ft.Bounds.XMax
Y2 = ft.Bounds.YMax
End If
first = False
Next
'Clear the selection so that you don't see the highlight pattern
objMap.Layers(strSearchLayer).Selection.ClearSelection
' return success
Nearest = True
End Function
Private Sub Form_Load()
Map1.CreateCustomTool 101, miToolTypePoint, miRadiusSelectCursor
End Sub
Private Sub Map1_ToolUsed(ByVal ToolNum As Integer, ByVal X1 As Double, ByVal Y1 As Double, ByVal X2 As Double, ByVal Y2 As Double, ByVal Distance As Double, ByVal Shift As Boolean, ByVal Ctrl As Boolean, EnableDefault As Boolean)
If ToolNum = 101 Then
Dim Radius As Single
Dim itemName As String
Dim xa As Double
Dim ya As Double
Dim xb As Double
Dim yb As Double
Dim strLyr As String
strLyr = "US Major Cities"
Radius = 500
If (Nearest(Map1, strLyr, X1, Y1, Radius, itemName, xa, ya, xb, yb)) Then
Text1 = itemName
Else
Text1 = "No Major City near there!"
End If
End If
End Sub===========
自定义范围专题图
===========
Mapx 的专题图用户可以进行完全的定制,下面是自定义范围专题图的例子。
Dim ds As New MapXLib.Dataset
Dim thm As New MapXLib.Theme
Set ds = Formmain.Map1.Datasets(ToolBars.Combo2.Text)
Set thm = ds.Themes.add(0, "aa", "aa", False)
thm.Legend.Compact = False
thm.AutoRecompute = False
'thm.ComputeTheme = False
thm.DataMax = 700
thm.DataMin = 100
thm.ThemeProperties.AllowEmptyRanges = True
thm.ThemeProperties.NumRanges = 7
thm.ThemeProperties.DistMethod = miCustomRanges
thm.ThemeProperties.RangeCategories(1).Max = 150
thm.ThemeProperties.RangeCategories(1).Min = 50
thm.ThemeProperties.RangeCategories(2).Max = 250
thm.ThemeProperties.RangeCategories(2).Min = 150
thm.ThemeProperties.RangeCategories(3).Max = 350
thm.ThemeProperties.RangeCategories(3).Min = 250
thm.ThemeProperties.RangeCategories(4).Max = 450
thm.ThemeProperties.RangeCategories(4).Min = 350
thm.ThemeProperties.RangeCategories(5).Max = 550
thm.ThemeProperties.RangeCategories(5).Min = 450
thm.ThemeProperties.RangeCategories(6).Max = 650
thm.ThemeProperties.RangeCategories(6).Min = 550
thm.ThemeProperties.RangeCategories(7).Max = 750
thm.ThemeProperties.RangeCategories(7).Min = 650
'thm.ComputeTheme = True
thm.AutoRecompute = True
thm.Visible = True
- 查找最近的实体
- 查找最近的点
- POJ4134查找最近的元素
- compass-实体的独立查找性
- VB + MapX 查找最近的图元
- Linux查找最近修改的文件
- find 查找最近修改的文件
- jquery查找最近的父节点
- C++ 二分查找 求最近的值
- linux查找最近修改过的文件
- 范围查找 和最近的一些感想
- Linux查找最近修改的文件
- Linux查找最近修改的文件
- 查找两个节点最近的公共祖先
- 自定义注解(反射机制)查找实体间的不同
- 查找最近元素
- 最近元素查找
- linux,用find命令查找最近修改过的文件
- VB+MapX编程实现地图数据查询
- TDD,测试代码可以代替文档吗?
- ASP.NET MVC 入门4、Controller与Action
- 【ExtJs学习系列】Ext2.0框架的Grid使用介绍(五)
- asp中rs.open sql,conn,1,1中各参数的意义
- 查找最近的实体
- 在VB+Mapx5.0中新建图层及属性的源代码
- javascript:判断浏览器类型和客户端操作系统 (2009-06-02更新)
- 图元“复制”“剪切”“粘贴”代码
- 基于MAPX控件的鹰眼图实现
- Java程序的加密和反加密
- 2440 GPIO 控制方法
- ASP.NET MVC 入门5、View与ViewData
- ASP.NET MVC 入门6、TempData