|
跟踪过程: |
|
通过SuperMap的Selection得到所选线段,并把所选线段分成20段(可以根据需要改变),拆分线段用soGeoLine的方法ResampleEquidistantly(...).再取出点用SuperMap的TrackingLayer显示出来. |
|
Private Sub btnStartTrcak_Click() |
|
Set objRecordset = SuperMap1.Selection.ToRecordset(True) '把选择对象转换为记录集 |
|
If objRecordset Is Nothing Then Exit Sub '没有对象被选中 |
|
objRecordset.MoveFirst '定位到第一个记录 |
|
Do Until objRecordset.IsEOF |
|
Set objGeoLine = objRecordset.GetGeometry() '获取记录的线几何对象 |
|
dLen = objGeoLine.Length '获取线的长度 |
|
Set objGeoLineNew = objGeoLine.ResampleEquidistantly(dLen / 20) '把目标线重新分成20段 |
|
Set TrackRedLinePoints = Nothing '清空点实例集合 |
|
Set TrackRedLinePoints = objGeoLineNew.GetPartAt(1) '获取分段后的线段的点的集合 |
|
nCurPoint = 1 |
|
Timer1.Enabled = True '进行跟踪 |
|
|
Timer1.Enabled = True '可以进行跟踪了
dTimes = Timer()
dTimes = dTimes + 2.5 '每两段之间间隔2.5秒
'每段结束后的暂停
Do
If Timer1.Enabled = False Then
Do Until Timer() > dTimes
Loop
Exit Do
End If
DoEvents
Loop
objRecordset.MoveNext
Loop
End sub |
|
|
|
 |
|
Timer事件：用来产生动态的效果。 |
|
Private Sub Timer1_Timer() |
|
If TrackRedLinePoints.Count + 1 > nCurPoint Then |
|
'定义实例的风格类型 |
|
style.PenColor = 255 |
|
style.SymbolSize = 96 |
|
style.SymbolStyle = 1 |
|
'在SuperMap1的TrackingLayer上实现实例的沿线跟踪 |
|
SuperMap1.TrackingLayer.ClearEvents '清除所有实例 |
|
SuperMap1.TrackingLayer.AddEvent pnt, style, "plane" '增加当前实例 |
|
SuperMap1.TrackingLayer.Refresh '刷新 |
|
Dim x As Double, y As Double |
|
x = TrackRedLinePoints.Item(nCurPoint).x '获取新的点实例的X坐标 |
|
y = TrackRedLinePoints.Item(nCurPoint).y '获取新的点实例的Y坐标 |
|
SuperMap1.TrackingLayer.Event("plane").MoveTo x, y '移动点实例 |
|
SuperMap1.TrackingLayer.Refresh '刷新 |
|
nCurPoint = nCurPoint + 1 '下一个点 |
|
Else |
|
Timer1.enable=false |
|
End If |
|
End Sub |
相关评论
