【SuperMap .Net 组件】地图与场景同步（一）同步的十字丝

来源：互联网发布：单片机模拟程序编辑：程序博客网时间：2024/05/17 04:21

SuperMap Desktop里有二维地图与三维场景的同步功能，其中最明显得同步就是鼠标的同步。我在地图上移动鼠标，场景里就有一个十字丝符号，反之亦然。

这个效果需要借助类Map和Scene的ScreenLayer属性完成。ScreenLayer顾名思义就是在屏幕上的一个图层，一般情况下都是临时的，和它类似的还有一个TrackingLayer，这个跟踪图层的尺寸都是和地图或者场景想一致的，而ScreenLayer的单位是像素，更符合我们的要求。

大体思路就是如果鼠标在MapControl上移动，就得到鼠标在的MapControl上的屏幕坐标，转换为地图坐标，再转为场景坐标，最后转为相应位置在SceneControl上的屏幕坐标。得到这个坐标后，先清除SceneControl的ScreenLayer，再在ScreenLayer的相应位置上画个十字丝。如果是鼠标在SceneControl上的话就正相反。

两段代码一个写在捕捉MapControl.MouseMove事件的函数里，另一个写在捕捉SceneControl.MouseMove事件的函数里。具体看代码：

    Private Sub MapMouseMoveHandler(ByVal sender As Object, ByVal e As MouseEventArgs) Handles m_MapControl.MouseMove        Dim screenMapPoint As Point = e.Location        Dim mapPoint As Point2D = m_MapControl.Map.PixelToMap(screenMapPoint)        Dim scenePoint As Point3D = PrjToGeo(mapPoint) ''自己写的方法投影坐标转大地坐标        Dim screenScenePoint As Point = m_SceneControl.Scene.GlobeToPixel(scenePoint)        m_SceneControl.Scene.ScreenLayer.Clear()        m_SceneControl.Scene.ScreenLayer.XUnit = ScreenCoordinateUnit.Pixel   ''重要！！ 不写是没有效果的        m_SceneControl.Scene.ScreenLayer.YUnit = ScreenCoordinateUnit.Pixel        m_SceneControl.Scene.ScreenLayer.Add(createCrossLine(screenScenePoint, 200, 200), "cross") ''自己写的画十字丝的方法        m_SceneControl.Refresh()    End Sub

    Private Sub SceneMouseMoveHandler(ByVal sender As Object, ByVal e As MouseEventArgs) Handles m_SceneControl.MouseMove         Dim screenScenePoint As Point = e.Location        Dim scenePoint As Point3D = m_SceneControl.Scene.PixelToGlobe(screenScenePoint)        Dim mapPoint As Point2D = GeoToPrj(scenePoint)  ''自己写的方法大地坐标转投影坐标        Dim screenMapPoint As Point = m_MapControl.Map.MapToPixel(mapPoint)        m_MapControl.Map.ScreenLayer.Clear()        m_MapControl.Map.ScreenLayer.Add(createCrossLine(screenMapPoint, 200, 200), "")  ''自己写的话十字丝的方法        m_MapControl.Refresh()    End Sub

这个十字丝画得很二，是个一笔画，本来以为AddPart是分开的，但在场景里是连起来的。

    Private Function createCrossLine(ByVal center As Point, ByVal height As Double, ByVal width As Double) As GeoLine        Dim crossLine As GeoLine = New GeoLine()        If height > width Then            height = width        Else            width = height        End If        Dim h As Double = 0.1 * height        Dim w As Double = 0.1 * width        Dim point1 As Point2D = New Point2D(center.X - 0.5 * w, center.Y)        Dim point2 As Point2D = New Point2D(center.X + 0.5 * w, center.Y)        Dim point3 As Point2D = New Point2D(center.X, center.Y - 0.5 * h)        Dim point4 As Point2D = New Point2D(center.X, center.Y + 0.5 * h)        Dim c As Point2D = New Point2D(center.X, center.Y)        Dim points1 As Point2Ds = New Point2Ds(New Point2D() {point1, point2})        Dim points2 As Point2Ds = New Point2Ds(New Point2D() {point3, point4})        Dim points As Point2Ds = New Point2Ds(New Point2D() {point1, c, point4, point3, c, point2})        crossLine.AddPart(points)        If redCross Then            Dim geoStyle As GeoStyle = New GeoStyle()            geoStyle.LineColor = Color.Red            geoStyle.LineWidth = 1            crossLine.Style = geoStyle        End If        Return crossLine    End Function

0 0