MapObjects2可以处理的几何元素有Point 、Line、 Polygon、 Circle、 Rectangle,每种元素定义成一个对象。这些对象统称为Shape,但没有定义Shape对象。除了Point以外,其它四种都提供了交互式输入方法:TrackLine 、TrackPolygon、 TrackCircle、 TrackRectangle。
2.5.1 P
oint对象
Point是最简单的对象,语句
Dim pt As New MapObjects2.Point
pt.X = 30342
pt.Y = 43535
建立了一个Point实例。
2.5.2
Line及Polygon对象
1图形坐标数据
在MapObjects2中,Line与Polygon图形都用Point的有序集合的集合定义,称为parts,Point的有序集合定义一条折线,称为part,part的集合命名为Parts。只有一条折线的Line或Polygon实例的Parts集合中仅含有一个part。在Line中part的首尾两点不同,在Polygon中part的首尾两点用一个Point表示。
下面这段程序取自附属盘中的样例GeoData中的MouseDown事件过程,程序先根据鼠标位置查出一个省区,然后将省区多边形的坐标串加入到List1控件中。
Dim recs As MapObjects2.Recordset '查询结果记录集
Dim curX As Single, curY As Single '鼠标光标位置坐标
Case “显示选择的多边形坐标数据”
Dim pt As MapObjects2.Point
Dim dist As Double
Set pt = Map1.ToMapPoint(curX, curY) ‘根据屏幕坐标建立point实例
dist = 1000
Set recs = Map1.Layers(“china”).SearchByDistance(pt, dist, “”) ‘按距离查询
If recs.EOF Then Exit Sub
‘在列表框中显示省界坐标”
Dim shp As Polygon
Dim pts As MapObjects2.Points
Dim i As Integer
Dim j As Integer
Set shp = recs(“Shape”).Value
Me.List1.Clear
Me.List1.AddItem “Parts.Count = “ & shp.Parts.Count
Me.List1.AddItem recs.Fields(“Name”) + “省界坐标”
For j = 0 To shp.Parts.Count-1
Set pts = shp.Parts(j)
For i = 0 To pts.Count - 1
Me.List1.AddItem (Str(pts.Item(i).X) & “ “ & Str(pts.Item(i).Y))
Next i
Next j
Map1.Refresh ‘触发Map1_AfterTrackingLayerDraw事件过程,绘制查询结果图
End Select
2 Points集合与Parts集合
在Polygon及Line对象中,Points是点的集合,Parts是Points的集合。以下是集合上的常用操作:
Dim poly As MapObjects2.Polygon
Dim pts As MapObjects2.Points
Set poly = Map1.TrackPolygon ‘鼠标跟踪绘制一个多边形
Set pts = poly.Parts.Item(0) ‘获得多边形中Points集合的引用
pts.Remove pts.Count –1 ‘删除多边形上的最后一点
Dim pt As New MapObjects2.Point
pt.X = 2300
pt.Y = 4500
pts.Set 2 , pt ‘替换pts集合中的点pts.Item(2)
pts.Reverse ‘改变pts中点的排列方向
在Polygon对象中,Points集合中点的排列方向赋予了特殊的含义。简单Polygon边界Points点按顺时针方向排列。含有岛区的复合Polygon的外围边界线点按顺时针方向排列,内部岛区边界线点按逆时针方向排列。
Parts集合是不可创建对象,Polygon与Line的Parts属性也是只读的。在创建Polygon或Line对象的实例同时创建了Parts实例,且用Parts属性引用Parts实例。可按如下步骤建立一个完整的Polygon实例:
1创建一个Polygon对象实例。
2创建Points对象实例。
3创建Point对象实例,设置它的X、Y属性值,用Pionts.Add方法添加到Points实例中。
4重复步骤3,将所有的点加入到Points实例中。
5用Polygon.Parts.Add方法将Points实例加入到Parts属性中。
单Part的Polygon用上述5步即可建立。 对于多Part的Polygon重复步骤5。
同理可以建立Line实例。
2.5.3
几何对象的运算
MapObject2 的几何对象共有6种,符号常量由枚举表ShapeTypeConstants定义如下
符号常量 |
值 |
对象名 |
moShapeTypePoint |
21 |
Point |
moShapeTypeLine |
22 |
Line |
moShapeTypePolygon |
23 |
Ploygon |
moShapeTypeMultipoint |
24 |
Points |
moShapeTypeRectangle |
25 |
Rectangle |
moShapeTypeEllipse |
26 |
Ellipse |
六种对象的父对象都是Object。
例:判断几何对象的类型。
Dim ObjA As Object
Dim ObjPoint As New MapObjects2.Point
Dim ObjPolygon As New MapObjects2.Polygon
Set ObjA = ObjPoint
If ObjA.shapeType = moShapeTypePoint Then Debug.Print "ObjA类型是Point"
Set ObjA = ObjPolygon
If ObjA.shapeType = moShapeTypePolygon Then Debug.Print "objA的类型是Polygon "
几何对象的运算在上表中6种对象的实例上进行,由实例的方法完成运算,运算数据来源于实例及实例方法中的参数。
1 IsPointIn
Function IsPointIn(pt As Point) As Boolean
适用对象: Polygon, Rectangle,Ellipse
这个方法判断点是否位于几何对象围成的区域中。例:
Dim pt as New MapObjects2.Point
pt.X = 1200
pt.Y = 2000
if Not Map1.Extent.IsPointIn(pt) Then ‘Map.Extent是Ractangle对象
Map1.CenterAt pt.X, pt.Y ‘以pt为中心显示地图
End If
2 GetCrossings
Function GetCrossings(Shape As Object) As Points
适用对象: Point,Points,Line, Polygon, Rectangle
这个函数计算两个几何图形的交点集合。例:
Dim shape As New MapObjects2.Line
Dim aPoly As New MapObjects2.Polygon
Dim pts As MapObjects2.Points
设置shape和aPoly的parts属性值
Set pts = aPoly.GetCrossings(shape) ‘返回交点集合的引用
3
Function
适用对象: Point, Points, Line, Polygon, Rectangle, Ellipse
这个函数返回两个几何图形的并。
Polygon和Rectangle都表示面,归为同一类类型。参与运算的两个对象应属于同一类型对象。例:
Dim aPoly As MapObjects2.Polygon
Dim bPoly As MapObjects2.Polygon
Dim cPoly As MapObjects2.Polygon
设置aPoly及bPoly的parts属性值
Set cPoly = aPoly.Union(bPoly)
4 Intersect
Function Intersect(Shape As Object,[Extent]) As Object
这个
句法:
Set resultShape = object.Intersect (Shape [,extent])
object可以是: Point, Points, Line, Polygon, Rectangle, Ellipse 6 种对象
Shape可以是: Point, Points, Line, Polygon, Rectangle, Ellipse 6 种对象
resultShape的类型随object与Shape的组合而异,如下表所示
resultShape的类型
Shape object |
Point |
Points |
Line |
Polygon |
Rectangle |
Ellipse |
Point |
Point |
Point |
Point |
Point |
Point |
Point |
Points |
Point |
Point 或Points |
Point 或Points |
Point或Points |
Point 或Points |
Point 或Points |
Line |
Point |
Point 或Points |
Point 或Points |
Line |
Line |
Line |
Polygon |
Point |
Point 或Points |
Line |
Polygon |
Polygong或Ractangle |
Polygon |
Rectangle |
Point |
Point 或Points |
Line |
Polygon或Ractagle |
Ractangle |
Polygon或 Ractangle |
Ellipse |
Point |
Point 或Points |
Line |
Polygon |
Polygon或 Ractangle |
Polygon |
5 Difference
Function Difference(Shape As Object,[Extent]) As Object
适用对象: Point, Points, Line, Polygon, Rectangle, Ellipse
这个函数返回两个几何图形的差。例:
Set cPoly = aPoly.Difference(bPoly)
6 Xor
Function Xor(Shape As Object,[Extent]) As Object
适用对象: Point, Points, Line, Polygon, Rectangle, Ellipse
这个函数返回两个几何图形的异或。例:
Set cPoly = aPoly.Xor(bPoly)
7 Buffer
Function Buffer(distance As Object, [Extent]) As Object
适用对象: Point, Points, Line, Polygon, Rectangle, Ellipse
Buffer函数返回边界距离调用对象为distance的Polygon。例:
Dim aPoly As MapObjects2.Polygon
Dim aLine As New MapObjects2.Line
设置aLine的Parts属性值
Set aPloly = aLine.Buffer(120)
在MapObjects2中,Buffer Intersect Difference Union及Xor方法使用整数坐标,具有较高的计算速度。为确保从浮点数转换到整数保持几何操作的一致性,建议使用Rectangle型的Extent参数,对所有的几何操作使用相同的Extent参数。若不使用参数Extent,对相同的Shape重复使用几何方法,不同次的结果图形的几何坐标可能会出现计算误差。
如果在方法中没有使用Extent参数,Mapobjets2使用两个源Shape的外接矩形的并。
例1 在跟踪层画两个Polygon 求它们的Xor,用不同的颜色在跟踪层显示源Polygon和结果Polygon。
完整代码在XorPolygon样例目录中。主要代码如下:
Dim shape1 As Object
Dim exclOr As Boolean
Private Sub Form_Load()
'设置PointEvents在跟踪层中得显示用的符号符号
exclOr = False
Map1.TrackingLayer.SymbolCount = 2
With Map1.TrackingLayer.Symbol(0)
.SymbolType = moFillSymbol '面(区域)
.Style = moGrayFill '半透明填充
.Color = moCyan
.OutlineColor = moCyan
End With
With Map1.TrackingLayer.Symbol(1)
.SymbolType = moFillSymbol
.Style = moGrayFill '半透明填充
.Color = moMagenta
.OutlineColor = moMagenta
End With
End Sub
Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
' 在Map1窗口中画两个Polygon 计算它们的 XOR
Dim poly As New MapObjects2.Polygon
Dim eventLine As New MapObjects2.GeoEvent
Set poly = Map1.TrackPolygon '在Map1窗口中画Polygon
Set eventLine = Map1.TrackingLayer.AddEvent(poly, 0) '在跟踪层中显示Poly
Call doXor(poly)
End Sub
Private Sub doXor(shape As Object) '计算两个Polygon的XOR
If Not exclOr Then '画第一个Polygon时保存到Shape1中
Set shape1 = shape
exclOr = True
ElseIf exclOr Then '画完第而个Polygon后则计算它们的 XOR
Dim xorShape As Object
Dim xorEvent As New MapObjects2.GeoEvent
Set xorShape = shape1.Xor(shape, Map1.FullExtent) '计算两个Polygon的Xor
Set xorEvent = Map1.TrackingLayer.AddEvent(xorShape, 1) '加入到跟踪层中
Set shape1 = Nothing
exclOr = False
End If
End Sub
习题
1 编写程序实现样例1的功能。
2 以习题1的代码为基础,写出Intersect程序,在程序中判断Intersect函数的返回结果的Shape类型。
2.5.4
动态分段
动态分段在Line对象上操作,是Line对象的特有方法操作的结果。在MapObjects2中Line表示有向折线,折线的折点称为Vertex(节点),折线的始末点称为Node(结点)。以始结点为度量起点,每个节点都有一个沿着折线的路程值,用路程值确定点在折线上的位置,给定的路程值确定了折线上的唯一点。
1点事件(PointEvents)
Line对象几何图形上的任意一点称为PointEvent,PointEvent专用于程序设计,可在程序运行中动态创建,动态改变位置,是动态的Point实例。
例:在长度为500的线实例aLine上创建距始点路程为400的点事件。
Dim ptsEvents As MapObjects2.Points
Set ptsEvents = aLine.ReturnPointEvents(400)
0 |
500 |
2线事件(LineEvent)
从Line对象几何图形上截取的任意一条线段称为LineEvent(线事件),LineEvent是动态创建的线实例,用线的始末点在原Line上的路程确定截取位置。
例:在长度为500的Line实例aLine上,创建始点路程200终点路程400的线事件。
Dim lineEvent as MapObjects2.Line
Set lineEvent = aLine.ReturnLineEvent(200,400)
3线的节点(Vertex)路程
Line对象实例上的节点距始结点(Node)的路程作为线的几何属性常用于最佳路径分析及网络分析,为此MapObjects.Line对象提供了两个方法:
(1) Sub SetMeasuresAsLength()
此方法为线的节点的Measure属性赋路程值, 路程值用地图的数据坐标计算,是地面上的实际路程。
例:在长度为500的线实例aLine上设置节点的Measure(路程)属性值
aLine.SetMeasuresAsLength
0 |
80 |
280 |
310 |
500 |
180 |
从上例可见,aLine的始末结点也算作节点。
(2) Sub SetMeasures(StartValue As Double,EndValue As Double)
此方法用StartValue作为始节点的路程值,用EndValue作为末节点的路程值,在这两个值之间按新旧路程的比例插值作为中间节点的路程值,将计算结果赋给节点的Measure属性。执行此函数之前可执行也可不执行SetMeasuresAsLength函数。
例:对上例中aLine实例重新设置节点的路程属性值,使得始节点的路程值为1,末节点的路程值为251,中间节点路程值按新旧路程值比例计算。
aLine.SetMeasurs(1,251)
1 |
41 |
141 |
156 |
251 |
91 |
4动态分段样例
在MapObjects中,点事件将给定的线动态分为两段,称为动态分段(Dynamic Segmentation)。分段只是视觉上的效果,并未对线进行实际分割。动态分段函数不会更改线的节点坐标值。
例1 用鼠标在地图窗口中输入一点,找出最近的一条线,在线上分别使用3个Measure函数,显示出每个Measuer 函数设置的线的各个节点的Measure值。完整样例在SetMeasuer目录中
Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim pt As MapObjects2.Point
Dim recs As New MapObjects2.Recordset
Set pt = Map1.ToMapPoint(X, Y) '转换(X,Y)成地图数据坐标系下的坐标
Set recs = Map1.Layers(0).SearchByDistance(pt, Map1.ToMapDistance(150), "")
' 如果找到了一条线,则提取它的 shape 字段值储存在 oLine 变量中,
‘设置 measures 在列表框中显示oLine上的
' 的各个节点的Measure值。
If Not recs.EOF Then
Dim oLine As New MapObjects2.Line
Dim pointMeasuer As Double
Set oLine = recs("Shape").Value
Map1.TrackingLayer.ClearEvents
Map1.TrackingLayer.AddEvent oLine, 0
List1.Clear
List2.Clear
List3.Clear
Dim vertices As New MapObjects2.Points
Dim i As Integer
oLine.SetMeasuresAsLength
pointMeasuer = oLine.ReturnMeasure(pt)
List1.AddItem "鼠标点的 Measure: " & pointMeasuer
List1.AddItem "节点的 Measure:"
For Each vertices In oLine.Parts
For i = 0 To vertices.Count - 1
List1.AddItem vertices(i).Measure
Next i
Next vertices
oLine.SetMeasures 0, 100
pointMeasuer = oLine.ReturnMeasure(pt)
List2.AddItem "鼠标点的 Measure: " & pointMeasuer
List2.AddItem "节点的 Measure:"
For Each vertices In oLine.Parts
For i = 0 To vertices.Count - 1
List2.AddItem vertices(i).Measure
Next i
Next vertices
oLine.OffsetMeasures 50
pointMeasuer = oLine.ReturnMeasure(pt)
List3.AddItem "鼠标点的 Measure: " & pointMeasuer
List3.AddItem "节点的 Measure:"
For Each vertices In oLine.Parts
For i = 0 To vertices.Count - 1
List3.AddItem vertices(i).Measure
Next i
Next vertices
End If
End Sub
例2:在地图窗口中用鼠标左键输入一点,在Map1.Layers(“Road”)图层中找出与输入点距离最近的线,在找到的线上创建与输入点距离最近的点(点事件)。在跟踪层中用红色显示点事件。样例在PntEnt.vbp工程中,从中摘取的程序如下:
Private Sub Form_Load()
省略的其它语句
‘设置PointEvents在跟踪层中得显示符号
Map1.TrackingLayer.SymbolCount = 1
With Map1.TrackingLayer.Symbol(0)
.SymbolType = moPointSymbol
.Color = moRed
.Size = 6
.Style = moCircleMarker
End With
EndSub
Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
省略的其它语句
Case “点事件”
‘在道路图层上搜索与鼠标点最靠近的线
Dim pt As MapObjects2.Point
Dim recs As New MapObjects2.Recordset
Set pt = Map1.ToMapPoint(X, Y)
Set recs = Map1.Layers(“road”).SearchByDistance(pt, Map1.ToMapDistance(150), “”)
‘ 如果找到最近的线则将它的图形数据保存到gLine变量中
If Not recs.EOF Then
Map1.TrackingLayer.ClearEvents ‘清除跟踪层中的点事件
Dim gLine As New MapObjects2.Line
Set gLine = recs(“Shape”).Value
gLine.SetMeasuresAsLength ‘用长度设置线上节点的路程值
‘Get closest measure, and return point events
Dim nearMeasure As Double
Dim events As MapObjects2.Points
nearMeasure = gLine.ReturnMeasure(pt) ‘ gLine上与pt点最接近的点的路程值
Set events = gLine.ReturnPointEvents(nearMeasure) ‘返回GLine上路程值为nearMeasure的点
‘在地图窗口中显示events点
If Not events Is Nothing Then
Dim theSelected As MapObjects2.GeoEvent
Set theSelected = Map1.TrackingLayer.AddEvent(events, 0)
End If
End If
End Select
End Sub