|
画线跟踪是先画一条线，而画面跟踪是先画一个面,然后转化为线，再把线分段，取出分段后的线的节点，再通过SuperMap的TrackingLayer画出这些点. |
|
|
|
 |
|
SuperMap1.Action = scaTrackPolyline '画一条线 |
|
在SuperMap中获取刚才绘制的线条，在Tracked()事件中得到并对其进行划分以实现跟踪 |
|
Dim Lnt as soGeoLine |
|
Dim lnNew as soGeoLine |
|
Set Lnt = SuperMap1.TrackedGeometry '接受画线或面后的几何对象 |
|
'重采样距离，生成新的等距离的线段 |
|
dLen = Lnt.Length
Set lnNew = ln.ResampleEquidistantly(dLen / 20) '把获得的线条等距离生成有20个节点的新的线条
Set Points = lnNew.GetPartAt(1)
nCurPoint = 1
Timer1.Interval = 500
Timer1.Enabled = True
ViewCenter.x = SuperMap1.CenterX
ViewCenter.y = SuperMap1.CenterY |
|
Timer()事件中的以下代码用于实现跟踪 |
|
SuperMap1.TrackingLayer.ClearEvents '清除所有实例 |
|
SuperMap1.TrackingLayer.AddEvent Lnt, StyTracking, "" '增加目标线实例 |
|
SuperMap1.TrackingLayer.AddEvent pnt, style, "" '增加点实例 |
|
SuperMap1.TrackingLayer.Refresh '刷新 |
|
nCurPoint = nCurPoint + 1 '定位下一个点在点集合中的位置 |
|
|
|
|
|
 |
|
SuperMap1.Action = scaTrackPolygon '画一个面 |
|
画完线(面)后，在SuperMap1_Tracked()过程中把面转化成线 |
|
Set CurGeome = SuperMap1.TrackedGeometry '接受画线或面后的几何对象 |
|
Set Lnt = CurReig.ConvertToLine '把面转化成线 |
|
有了线段Lnt其它的就和画线跟踪的操作一样了，具体从重采样那一步开始。 |
|
|
|
|
|
通过从图上选取对象，如果是点对象就在该点的位置显示一个点实例；如果是线对象就对它进行重采样，生成新的线条再进行线段跟踪；如果是面对象，首先把它转为一个线对象，再对该线对象进行重采样，跟踪经过重采样后的线段。方法与画线跟踪、画面跟踪基本相同，只是获取几何对象的方式不同，下面只对几何对象的获取进行介绍，跟踪参考上面的代码。还有一点要注意的是如果选中的面对象是一个由几个简单面对象组成的复杂对象则不能生成线对象，因此就不能实现跟踪效果。 |
|
 |
|
设置为查询状态: |
|
SuperMap1.Action = scaSelect 'SuperMap1的状态设为"选择" |
|
在SuperMap1_GeometrySelected(ByVal nSelectedGeometryCount As Long)中得到选取的的对象并进行转换.为面则转换为线，点和线不用转换.再激发Timer()事件进行跟踪。 |
|
Dim objRecordset As soRecordset '定义选择记录变量
Dim objCurGeome As soGeometry '定义记录几何对象接受变量
Dim objCurReig As soGeoRegion '定义跟踪面变量
Dim objStyle As New soStyle '定义跟踪线的风格变量
Set objRecordset = SuperMap1.Selection.ToRecordset(True) '获取选中对象的记录
SuperMap1.Selection.RemoveAll '清除被选中的对象的高亮显示
Set objCurGeome = objRecordset.GetGeometry '获得刚才被选中记录的几何对象
If objCurGeome.Type = scgLine Then '线对象
Set Lnt = objCurGeome
ElseIf objCurGeome.Type = scgRegion Then '面对象
Set objCurReig = objCurGeome
Set Lnt = objCurGeome.ConvertToLine()
ElseIf objCurGeome.Type = scgPoint Then '点对象
objStyle.PenColor = vbRed
objStyle.SymbolSize = 96
objStyle.SymbolStyle = 1
SuperMap1.TrackingLayer.ClearEvents '清除跟踪图层上的实例
SuperMap1.TrackingLayer.AddEvent objCurGeome, objStyle, "" '增加点实例
SuperMap1.TrackingLayer.Refresh '刷新跟踪图层
End If |
|
|
|
|
|
视图即时放大就是如图所示，在移动鼠标时显示一个即时虚拟放大窗口（其实就是在SuperMap的TrackingLayer上增加的两个实例），当您按下鼠标时就把虚拟窗口中的视图放大到整个显示窗口。定位是用于放大局部地图以便于选取目标,在MouseUp()和MouseMove()事件中实现. |
|
 |
|
|
|
Private Sub SuperMap1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim xx As Double, yy As Double
xx = SuperMap1.PixelToMapX(ScaleX(x, vbTwips, vbPixels)) '转换X坐标
yy = SuperMap1.PixelToMapY(ScaleY(y, vbTwips, vbPixels)) '转换Y坐标
Dim pnt As New soGeoPoint, style As New soStyle, lin As New soGeoLine, bnd As soRect
Dim part As New soPoints, cx As Double, cy As Double
Set bnd = SuperMap1.ViewBounds
cx = bnd.Width() / 6 '虚拟窗口为原窗口的1/6
cy = bnd.Height() / 6
'生成虚拟窗口的四个顶点
part.Add2 xx - cx, yy + cy
part.Add2 xx + cx, yy + cy
part.Add2 xx + cx, yy - cy
part.Add2 xx - cx, yy - cy
Part.Add2 xx - cx, yy + cy
lin.AddPart part '生成视图框
pnt.x = xx ' 虚拟窗口中心点
pnt.y = y
ViewCenter.x = xx
ViewCenter.y = yy
'设置风格属性
style.PenColor = 255
style.SymbolSize = 50
style.SymbolStyle = 1
SuperMap1.TrackingLayer.ClearEvents '清除所有实例
SuperMap1.TrackingLayer.AddEvent lin, style, "" '增加线实例
SuperMap1.TrackingLayer.AddEvent pnt, style, "" '增加点实例
SuperMap1.TrackingLayer.Refresh '刷新
End Sub |
|
|
|
Private Sub SuperMap1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Set View = SuperMap1.ViewBounds
SuperMap1.ViewScale = SuperMap1.ViewScale * 3 '放大显示比例
SuperMap1.CenterX = ViewCenter.x '重新定位视图中心
SuperMap1.CenterY = ViewCenter.y
End Sub |
相关评论
