测量线段长度.docx

Option ExplicitDim dc As New DataConnection 数据源Dim layer As MapLayer 图层变量Dim strscale As String 记录比例尺，决定注记是否显示Dim cnt As Integer 测距Dim pts As mapobjects2.Points 画线测距离定义点Dim g_line As mapobjects2.Line 画线测距离定义线Dim poly As mapobjects2.Polygon 画多边形测周长和面积定义多边形Dim p As mapobjects2.PointPublic Sub LayerLoad(Map As Map)Set layer = New MapLayer 动态申请 一个图层变量layer.GeoDataset = dc.FindGeoDataset(省界_region) 加入第一个图层layer.Symbol.Color = RGB(255, 255, 190)layer.Symbol.OutlineColor = RGB(255, 255, 190)Map.Layers.Add layerEnd SubPrivate Sub Map1_AfterTrackingLayerDraw(ByVal hdc As stdole.OLE_HANDLE)Dim sym As New Symbol 在map1上画线或多边形Dim symstr As New Symbol 鼠标移动选中的街道的符号Dim i As LongIf Not g_line Is Nothing And Not pts Is Nothing Then sym.Color = moBlack Map1.DrawShape pts, sym If pts.Count 1 Then sym.Color = moRed Map1.DrawShape g_line, sym End IfElseIf Not poly Is Nothing And Not pts Is Nothing Then sym.Color = moBlue Map1.DrawShape pts, sym If pts.Count 1 Then sym.Color = moRed sym.SymbolType = moFillSymbol sym.Style = 7 sym.Size = 1 Map1.DrawShape poly, sym End IfEnd IfEnd SubPrivate Sub Map1_DblClick()双击求线长和面积 If Toolbar1.Buttons(1).Value = 1 Then MsgBox 距离= & Format(g_line.Length, 0.00) & 米 Set pts = Nothing 再次测定时清除上次所画痕迹 Set g_line = NothingEnd If Map1.TrackingLayer.Refresh TrueEnd SubPrivate Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)Dim r As mapobjects2.Rectangle If Toolbar1.Buttons(1).Value = 1 Then 点击左键，则实现画直线测距离 If Button = vbLeftButton Then 量距离 Dim p1 As mapobjects2.Point If g_line Is Nothing Then Set g_line = New mapobjects2.Line End If If pts Is Nothing Then Set pts = New mapobjects2.Points End If Set p1 = Map1.ToMapPoint(X, Y) pts.Add p1 If pts.Count = 1 Then g_line.Parts.Add pts Set pts = g_line.Parts(0) End If Map1.Refresh End IfEnd IfEnd IfEnd SubPrivate Sub Map1_AfterLayerDraw(ByVal Index As Integer, ByVal canceled As Boolean, ByVal hdc As stdole.OLE_HANDLE) 量测距离时画点If Not pts Is Nothing Then If pts.Count = 1 Then Dim sym2 As New Symbol sym2.Color = moBlue sym2.SymbolType = moPointSymbol sym2.Size = 5 Map1.DrawShape pts, sym2 End IfEnd If量测距离时画线Dim sym As New SymbolIf Not g_line Is Nothing Then If pts.Count 1 Then sym.Color = moRed sym.SymbolType = moLineSymbol sym.Size = 1 Map1.DrawShape g_line, sym End If End IfEnd SubPrivate Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)If Toolbar1.Buttons(1).Value = 1 Then 点击测距图标Set pts = NothingSet poly = NothingMap1.MousePointer = moCrossEnd IfEnd SubPrivate Sub Form_Loa