图元操作实例

最新推荐文章于 2021-11-12 22:19:28 发布

原创最新推荐文章于 2021-11-12 22:19:28 发布 · 1.4k 阅读

1 ·

CC 4.0 BY-SA版权

文章标签：

#command #object #distance #integer #layer

MapX 专栏收录该内容

23 篇文章

订阅专栏

本文提供了一个使用MapXLib库进行地图操作的示例代码，包括缩放、平移、选择功能，以及创建临时图层、添加特征、移动和删除特征等操作。通过具体的VBScript实现细节，展示了如何在地图应用程序中实施这些常用功能。

Dim ftr As New MapXLib.Feature Dim ftr1 As New MapXLib.Feature Private Sub Command1_Click() Map1.CurrentTool = miZoomInTool End Sub Private Sub Command2_Click() Map1.CurrentTool = miZoomOutTool End Sub Private Sub Command3_Click() Map1.CurrentTool = miSelectTool End Sub Private Sub Command4_Click() Map1.CurrentTool = miPanTool End Sub Private Sub AddLayerInfo() '创建新的临时图层，包含 USA 图层中选择的所有 '图元 Dim li As New MapXLib.LayerInfo Dim ftrs As MapXLib.Features Dim flds As MapXLib.Fields Dim ds As MapXLib.Dataset '新表和 USA 图层具有相同的列结构 Set ds = Map1.Datasets.Add(miDataSetLayer, Map1.Layers("China")) Set flds = ds.Fields li.Type = miLayerInfoTypeTemp li.AddParameter "Name", "TempLayer" li.AddParameter "Fields", flds '该图层在添加到图层集合时创建 Map1.Layers.Add li End Sub Private Sub Command5_Click() If Combo1.ListIndex <> 0 Then Set ftr1 = Map1.Layers.Item("TempLayer").GetFeatureByID(Combo1.List(Combo1.ListIndex)) ftr1.Offset 1, 0 ftr1.Update Else MsgBox "请先选择图元" End If End Sub Private Sub Command6_Click() Set ftr1 = Map1.Layers.Item("TempLayer").GetFeatureByID(Combo1.List(Combo1.ListIndex)) Map1.Layers.Item("TempLayer").DeleteFeature ftr1 Combo1.RemoveItem Combo1.ListIndex End Sub Private Sub Form_Load() AddLayerInfo Map1.Zoom = 3000 Dim newobj As New MapXLib.Feature 'stand-alone object Dim obj As MapXLib.Feature 'to hold object added to layer Dim pts As New Points Dim pt As New Point Dim ftrs As New MapXLib.Features Dim ftrfac As New MapXLib.FeatureFactory Dim newStyle As New MapXLib.Style Map1.AutoRedraw = False Map1.Layers.Item("TempLayer").Editable = True newobj.Attach Map1 newobj.Type = miFeatureTypeLine 'Use the map's default symbol style newobj.Style.LineStyle = 92 newobj.Style.LineColor = miColorRed With newStyle .SymbolType = miSymbolTypeBitmap .SymbolBitmapSize = 24 .SymbolBitmapTransparent = True .SymbolBitmapName = "CAUT1-32.BMP" End With 'set the lines 3 points pt.Set 112.4382, 38.036 pts.Add pt Set ftr = Map1.FeatureFactory.CreateSymbol(pt, newStyle) Set ftr = Map1.Layers.Item("TempLayer").AddFeature(ftr) Combo1.AddItem ftr.FeatureID pt.Set 103.4736, 36.3211 pts.Add pt Set ftr = Map1.FeatureFactory.CreateSymbol(pt, newStyle) Set ftr = Map1.Layers.Item("TempLayer").AddFeature(ftr) Combo1.AddItem ftr.FeatureID pt.Set 113.9713, 30.7796 pts.Add pt Set ftr = Map1.FeatureFactory.CreateSymbol(pt, newStyle) Set ftr = Map1.Layers.Item("TempLayer").AddFeature(ftr) Combo1.AddItem ftr.FeatureID pt.Set 113.1571, 23.236 pts.Add pt Set ftr = Map1.FeatureFactory.CreateSymbol(pt, newStyle) Set ftr = Map1.Layers.Item("TempLayer").AddFeature(ftr) Combo1.AddItem ftr.FeatureID pt.Set 85.5813, 42.303 pts.Add pt Set ftr = Map1.FeatureFactory.CreateSymbol(pt, newStyle) Set ftr = Map1.Layers.Item("TempLayer").AddFeature(ftr) Combo1.AddItem ftr.FeatureID newobj.Parts.Add pts 'now add the object to a layer ' obj will be the newly added object Set obj = Map1.Layers("TempLayer").AddFeature(newobj) Map1.AutoRedraw = True Map1.Layers.Item("TempLayer").Editable = False End Sub Private Sub Map1_ToolUsed(ByVal ToolNum As Integer, ByVal X1 As Double, ByVal Y1 As Double, ByVal X2 As Double, ByVal Y2 As Double, ByVal Distance As Double, ByVal Shift As Boolean, ByVal Ctrl As Boolean, EnableDefault As Boolean) 'MsgBox "X:" + X1 + "Y:" + Y1 End Sub