为了正常的体验网站,请在浏览器设置里面开启Javascript功能!

gis二次开发

2011-06-23 18页 doc 77KB 24阅读

用户头像

is_864665

暂无简介

举报
gis二次开发GIS的二次开发——使用pb调用mapx控件(原创) GIS的二次开发——使用pb调用mapx控件(原创) ///新建图层的函数 //wf_add_layer oleobject aLayer,lb_dataset,LayerInfo,Flds ole_1.object.Geoset='H:\water_pt_map.gst' alayer=Create OleObject alayer.ConnectToNewObject("MapX.Layer.5") LayerInfo=Create OleObject LayerInf...
gis二次开发
GIS的二次开发——使用pb调用mapx控件(原创) GIS的二次开发——使用pb调用mapx控件(原创) ///新建图层的函数 //wf_add_layer oleobject aLayer,lb_dataset,LayerInfo,Flds ole_1.object.Geoset='H:\water_pt_map.gst' alayer=Create OleObject alayer.ConnectToNewObject("MapX.Layer.5") LayerInfo=Create OleObject LayerInfo.ConnectToNewObject("MapX.LayerInfo.5") Flds=Create OleObject Flds.ConnectToNewObject("MapX.fields.5") Flds.AddStringField ("ID", 12 ) Flds.AddStringField ("Name", 50) //新建图层 LayerInfo.Type = 6 LayerInfo.AddParameter ("NAME", 'meteruse') LayerInfo.AddParameter ("Fields", Flds ) LayerInfo.AddParameter ("AUTOCREATEDATASET", 1) LayerInfo.AddParameter ("DATASETNAME", "PT_WATER") alayer = ole_1.object.Layers.Add(LayerInfo, 1) //设置活动图层 ole_1.object.layers.animationlayer = alayer // //======================== //name:wf_add_dot //dec{3} ldc_x,ldc_y // //增加点的函数,分级别显示 // //time:20040924 // //======================= long ll_f //按照级别设置颜色 if il_jb = 1 then ole_1.object.DefaultStyle .SymbolCharacter = 35 ole_1.object.DefaultStyle .SymbolFontColor = RGB(255, 0, 0) ole_1.object.DefaultStyle .SymbolFont.Size = 12 //ole_1.object.DefaultStyle .SymbolFont="Map Symbols" ole_1.object.DefaultStyle .textFontColor = RGB(255, 0, 0) ole_1.object.DefaultStyle .textFont.Size = 12 ole_1.object.DefaultStyle .textFont="宋体" elseif il_jb = 2 then ole_1.object.DefaultStyle .SymbolCharacter = 36 ole_1.object.DefaultStyle .SymbolFontColor = RGB(255, 255, 0) ole_1.object.DefaultStyle .SymbolFont.Size = 11 ole_1.object.DefaultStyle .textFontColor = RGB(255, 255, 0) ole_1.object.DefaultStyle .textFont.Size = 11 elseif il_jb = 3 then ole_1.object.DefaultStyle .SymbolCharacter = 37 ole_1.object.DefaultStyle .SymbolFontColor = RGB(255, 127, 0) ole_1.object.DefaultStyle .SymbolFont.Size = 10 ole_1.object.DefaultStyle .textFontColor = RGB(255, 127, 0) ole_1.object.DefaultStyle .textFont.Size = 10 end if int i,n=1 oleobject f,f2,lb_dataset,flds,rv oleobject aLayer oleobject m_point lb_dataset=Create OleObject lb_dataset.ConnectToNewObject("MapX.dataset.5") flds=Create OleObject flds.ConnectToNewObject("MapX.fields.5") rv=Create OleObject rv.ConnectToNewObject("MapX.rowvalue.5") alayer=Create OleObject //("mapx.layer.5") f=Create OleObject f2=Create OleObject m_point =Create OleObject alayer.ConnectToNewObject("MapX.Layer.5") ll_f = f.ConnectToNewObject("MapX.Feature.5") ll_f = f2.ConnectToNewObject("MapX.Feature.5") ll_f = m_point.ConnectToNewObject("MapX.point.5") aLayer=ole_1.object.layers.item("meteruse") lb_dataset = aLayer.Datasets.Item("PT_WATER") flds=lb_dataset.Fields aLayer.LabelProperties.Dataset =lb_dataset aLayer.LabelProperties.DataField =lb_dataset.Fields.Item("id") aLayer.autolabel=true aLayer.Editable=True if is_name <>"" and not isnull(is_name) then if il_same_f = 1 then//已经在地图上存在的 移动坐标 f = aLayer.GetFeatureByKey (is_FeatureKey) f.point.Set(adc_x ,adc_y) f.update() else//没有存在的增加之 ole_1.object.AutoRedraw=False m_point.Set(adc_x ,adc_y) f = ole_1.object.featurefactory.createsymbol(m_point,ole_1.object.defaultstyle) aLayer.KeyField= Flds.Item(1).Name f.KeyValue=is_name f2=aLayer.addfeature(f) is_FeatureKey =f2.FeatureKey il_same_f = 1 end if aLayer.Refresh ole_1.object.AutoRedraw=true end if //===================================== //name :wf_delete_feature // //string as_featruekey //删除地图上的一个 符号 // // //20040913 //=================================== oleobject aLayer alayer=Create OleObject //("mapx.layer.5") alayer.ConnectToNewObject("MapX.Layer.5") aLayer=ole_1.object.layers('meteruse') aLayer.DeleteFeature(as_featruekey) aLayer.refresh   摘要 本文介绍了VB中如何利用MapX创建用户定制地图工具,详细地说明了整个创建过程,以及在创建定制工具的过程中所使用的关键方法。   1.前言   随着地理信息系统的发展,国内外已出现了不少GIS(地理信息系统)软件,其中MapX是MapInfo公司的ActiveX控件产品。由于它是一种基于Windows操作系统的控件,因而MapX4.0支持绝大多数标准的可视化开发环境,如:VisualBasic,Delphi,PowerBuilder,VisualC++等面向对象语言,而且可以使用Lotus Script将MapX4.0嵌入到Lotus Notes中。   虽然MapX4.0提供了许多标准工具,可以直接使用,但是很多情况下,这些标准工具不能满足实际的需要,这就通过定制地图工具来规定工具能完成何种功能,例如画椭圆工具,标尺工具(测线段长度)等等。下面,笔者就通过一具体实例来介绍一下VB中采用MapX4.0控件制作地图的定制工具。   2.VB环境下MapX编程   利用MapX4.0创建用户定制工具分为以下三步:   2.1 创建定制工具   本例创建的是画椭圆工具。首先,宣称全局常量miAddEllipseTool = 1,1就代表了画椭圆这个工具。然后,在主窗体中创建画椭圆工具。 关键方法(创建定制工具): OBJECT.CreateCustomTool (ToolNumber, Type, Cursor, [ShiftCursor] , [CtrlCursor], [InfoTips])   OBJECT(对象):Map对象;   ToolNumber(工具号)是创建出代表画椭圆工具的miAddEllipseTool;   Type(类型):描述了工具的行为,这个参数取的ToolTypeConstants(工具类型常量)值。本例,工具是按下鼠标左键到弹上鼠标左键的过程中画椭圆。本例中取的是miToolTypePoint;   Cursor(指针形状):使用该工具时,该工具在地图上显示的形状,该参数从CursorConstants(指针常量)中取值。本例选用的是miCrossCursor,那么当选择该工具时,该工具将在地图上显示成十字叉形状;   ShiftCursor ,CtrlCursor:这两个参数是可选的,缺省情况时,SHIFT键和CTRL键不起作用;   InfoTips(工具提示): Boolean型。 如果要显示工具提示,需要将此参数设为true;缺省值为false。   实际编码: Public Const miAddEllipseTool = 1 '定制的加椭圆工具 Public RectX1 As Double '新加椭圆(所需的矩形)的点1的X(经纬度)坐标 Public RectY1 As Double '新加椭圆(所需的矩形)的点1的Y(经纬度)坐标 Public RectX2 As Double '新加椭圆(所需的矩形)的点2的X(经纬度)坐标 Public RectY2 As Double '新加椭圆(所需的矩形)的点2的Y(经纬度)坐标 Private Sub Form_Load() '创建定制工具 Map1.CreateCustomTool miAddEllipseTool, _ miToolTypePoint, miCrossCursor End Sub   此时所创建的工具没有任何功能,要工具具备相应的功能由第二步实现。 2.2编写工具句柄 (工具具备什么功能)。   当按下鼠标左键时,需要记下椭圆的起始位置;当鼠标右键弹上时,需要记下椭圆的结束位置,这时,画出椭圆。椭圆将以这两点为矩形的对角线在矩形框中绘制椭圆。需要特别注意的是,MapX4.0中使用的坐标系统是经/纬度系统,而MouseDOwn,MouseUp事件中的坐标是屏幕坐标,因此,需要将屏幕坐标转化为经/纬度坐标,所画椭圆才能显示在正确的位置上。   关键方法(绘制椭圆): OBJECT.CreateEllipticalRegion(Rectangle,[Angle] , [Resolution] , [Style] ) OBJECT:FeatureFactory对象; Rectangle(矩形):Rectangle对象,确定了椭圆的大小; Angle(角度):变量,决定椭圆绕中心点旋转的角度; Resolution(精度) :变量, 椭圆的精度,由多少点构成; Style(样式): 变量,定义了所画椭圆的样式,如颜色,线型等。 实际编码: Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = vbLeftButton And (Map1.CurrentTool = miAddEllipseTool) Then  Map1.NumericCoordSys.Set miLongLat, 0  '将屏幕坐标转变为经纬度坐标  Map1.ConvertCoord X, Y, RectX1, RectY1, miScreenToMap  End if End Sub Private Sub Map1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)  If Button = vbLeftButton And (Map1.CurrentTool = miAddEllipseTool) Then   '将地图的坐标系统设为经/纬度坐标   Map1.NumericCoordSys.Set miLongLat, 0   '将屏幕坐标转变为经纬度坐标   Map1.ConvertCoord X, Y, RectX2, RectY2, miScreenToMap   '鼠标弹起时,画椭圆   Call AddEllipse(form1,RectX1,RectY1,RectX2,RectY2)  Endif End sub '画椭圆过程 Public Sub AddEllipse(frm As Form, x1 As Double, _ y1 As Double,x2 As Double,y2 As Double, EditLayer As Variant)  Dim RECT As New MapXLib.Rectangle '画椭圆的矩形框  Dim CreatedEllipse As Feature '所画的椭圆  Dim I as integer,EditLayer as integer  '设置画椭圆的矩形框  RECT.Set x1, y1, x2, y2  With frm.Map1   '创建椭圆   Set CreatedEllipse = .FeatureFactory. _   CreateEllipticalRegion(RECT, , 500, .DefaultStyle)   '确定哪一层是可编辑层,椭圆只能画在可编辑层上   For I=1 to .map1.layers.count    If .map1.layers(I).editable=true then     Editlayer=I     Exit for    Endif   Next I   '将椭圆添加到所画的图层上   .Layers.Item(EditLayer).AddFeature CreatedEllipse  End With End Sub   此时,画椭圆工具具备了画椭圆的功能,运用定制的这个工具由第三步实现。   2.3调用定制工具   '设置当前工具为定制的画椭圆工具   Map1.CurrentTool=miAddEllipse   或 Map1.currenttool=1   3. 结束语   本例画椭圆时,从鼠标按下,一直到鼠标最后弹起时才可以看到椭圆出现在地图上,这就是说在鼠标移动(MouseMove事件)时,从鼠标按下,到鼠标弹起的中间过程是看不到中间过程的椭圆出现的。为了实现在鼠标移动时,也可以看到椭圆,那么需要在MouseMove事件中画椭圆,并且,每次画椭圆时删除掉前一次画的椭圆。这样的运行结果就是看到,从鼠标按下,到鼠标弹起的过程中,随鼠标的移动而有了绘椭圆的变化过程。    另外,本文是以VB5为例,进行的编程,但对于其它语言,如VC++,Delphi等,编程思路和关键方法都是相同的。 上个月去天津做这个项目,加班加点忙乎过了十一,现在项目终于完成了第一阶段,可以闲下来一下了。    在做这个项目之前我只是自学了一个月的supermap,不过感觉gis这些东西都是大同小异,没什莫可怕;关键比较郁闷的是本来根本就是做.net,现在却要用vb实在太。。。算了,赶鸭子上架,不会也得会呀!     其实本人对这个实在只能称得上一知半解,学的和用的一样多,不过还是给自己和别人留下点东西吧,也许会有帮助呢:)     1,设置地图标题(Map1.Title)样式     在打开一个GeoSet时,会自动显示它的标题,如果你的GeoSet没有标题,它会自动添加一个标题。     你可以设置标题的样式,显示出最完美的地图      Map1.Title.Visible = False’是否可见      Map1.Title.Editable = False'是否可编辑      标题位置     Map1.Title.x = Map1.MapScreenWidth - 50     Map1.Title.y = 2    是否有边界     Map1.Title.Border = False     是否粗体    Map1.Title.TextStyle.TextFont.Bold = True     字体大小     Map1.Title.TextStyle.TextFont.Size = 15    是否在文本周围绘制光晕      Map1.Title.TextStyle.TextFontHalo = True    控制文本是否显示背景色      Map1.Title.TextStyle.TextFontOpaque = False    是否在文本下绘制阴影     Map1.Title.TextStyle.TextFontShadow = True 2 打开地图的两种方法    a,打开地图集     Map1.GeoSet =”C:\aa.gst”      在地图集里,你可以给地图加颜色,加标注,限制标注的字体,颜色等。这些只能保存到地图集,而不能保存到单一的图层里。所以建议你把图层做成地图集,这样无论是打开还是显示都很方便。    b,打开图层     For i = 1 To UBound(Navigation_DefaultMap_Path)       Map2.Layers.Add Navigation_DefaultMap_Path(i), i     Next 3添加数据集   mapx的地图和数据是分开的,你要想制作专题图,查看表的内容,取图元的数据,都要先添加数据集。  a,添加图层数据集   Set lyr = curMap.Layers(layerList.Text)     curMap.DataSets.Add miDataSetLayer, lyr, lyr.Name  b,添加自定义数据集   以下函数是添加一个数据集,sqlstr 是sql语句,DsName是数据集的名称。注意: "orderno", 是我在数据库中取的数据集与地图图元的关联。   Private Function AddJDDs(sqlstr As String, DsName As String) As Boolean Dim IsRight As Boolean IsRight = False '----------------------添加数据集 On Error GoTo ThemedCreate '------------是否存在该数据集  Dim ds As MapXLib.Dataset   For Each ds In Map1.DataSets  If ds.Name = DsName Then  Map1.DataSets.Remove (DsName) '删除数据集  Exit For  End If  Next  Set ds = Nothing  '------------------加载数据集----------------------------    Dim Cn As New ADODB.Connection  Dim Cmd As New ADODB.Command  Dim rs As New ADODB.Recordset Dim BindLyr As New BindLayer Cn.CursorLocation = adUseClient Cn.Open ConStr Set Cmd.ActiveConnection = Cn  Cmd.CommandText = sqlstr  rs.Open Cmd, , adOpenKeyset, adLockOptimistic     BindLyr.LayerType = miBindLayerTypeNormal If rs.RecordCount <> 0 Then Map1.DataSets.Add miDataSetADO, rs, DsName, "orderno", , BindLyr IsRight = True Else  MsgBox "无法显示数据,请检查数据是否为空?"  IsRight = False End If rs.Close Set rs = Nothing  Cn.Close  Set Cn = Nothing   Set Cmd = Nothing   Set BindLyr = Nothing AddJDDs = IsRight  Exit Function  '------------------------------------------------------------------- ThemedCreate:     MsgBox "加载数据集出错! 请检查数据是否正确?" & Err.Description     IsRight = False     AddJDDs = IsRight End Function 4关闭地图   a,关闭图层      Dim lyr As MapXLib.Layer     Dim i As Integer         For i = 0 To List1.ListCount - 1         If (List1.Selected(i) = True) Then             Set lyr = fMainForm.Map1.Layers(List1.List(i))             lyr.DataSets.RemoveAll                 fMainForm.Map1.Layers.Remove lyr         End If     Next i     Set lyr = Nothing   b,全部关闭      Map1.GeoSet = "" 6制作专题图   Map1.DataSets.Item(DsName).Themes.Add ThemeType, FieldList, "trafficflupiebar"   注意:如果是柱状图和饼图等可以是多个字段的,FieldList就是数组名;否则就是字段名。               如果你觉得制作的专题图不够大,可自己控制专题图的大小               Map1.DataSets.Item(DsName).Themes("trafficflubar").Properties.Size = 1‘图形的高度,默认值为 0.25 英寸               Map1.DataSets.Item(DsName).Themes("trafficflubar").Properties.BarWidth = 1‘每个柱体的宽度,默认值为 0.25 英寸              你可以改变专题图的图例,比如制作等级符号的专题图,默认的是#号,你可以改变成你喜欢的样式     Dim oStyle As style     Set oStyle = New style     oStyle.SymbolFont.Size = 35     oStyle.SymbolCharacter = 35     oStyle.SymbolFont.Name = "Map Symbols"    oStyle.SymbolFontColor = &HFF00FF Map1.DataSets.Item(DsName).Themes("trafficfluGradSymbol").Properties.SymbolStyle = oStyle Set oStyle = Nothing  7自定义专题图图例       Dim LegTexts As New MapXLib.LegendTexts   Dim tLegend As MapXLib.Legend Set tLegend = Map1.DataSets(DsName).Themes("trafficflubar").Legend   tLegend.Title = "交通流量"   tLegend.Left = Map1.MapScreenWidth - tLegend.Width     tLegend.Top = Map1.MapScreenHeight - tLegend.Height     tLegend.BodyTextStyle.TextFont.Size = 8   Set LegTexts = tLegend.LegendTexts   tLegend.Visible = True     LegTexts(1).Text = "小货"     LegTexts(2).Text = "中货"     LegTexts(3).Text = "大货" 8 邦定标注字段,自定义标注样式 sqlstr 是数据库取的数据集,showfield是要显示的字段名称   Sub showdatalable(sqlstr As String, showfield As String) '--------------------------显示标注 Dim CnShowData As New ADODB.Connection Dim Cmd As New ADODB.Command Dim rs As New ADODB.Recordset On Error Resume Next CnShowData.CursorLocation = adUseClient CnShowData.Open ConStr Set Cmd.ActiveConnection = CnShowData Cmd.CommandText = sqlstr rs.Open Cmd, , adOpenKeyset, adLockOptimistic If rs.RecordCount > 0 Then      Map1.AutoRedraw = False      rs.MoveFirst        Dim lyr As MapXLib.Layer     Dim ftr As MapXLib.Feature     Dim obj As MapXLib.Feature     Dim FId As Long     Dim rvs As RowValues     Dim ds As MapXLib.Dataset     Dim oStyle As style     Dim zi As Single  Do     FId = 0     If Map1.DataSets.Count > 0 Then       Set lyr = Map1.Layers.Item(JDlyrName)               Set ds = Map1.DataSets.Item(JDlyrName)             For Each obj In lyr.AllFeatures              Set rvs = ds.RowValues(obj)               If Trim(rvs.Item("编号").Value) = Trim(Str(rs!orderno)) Then               FId = obj.FeatureID               Exit For               End If             Next       If FId <> 0 Then         lyr.Selection.SelectByID FId, miSelectionNew '交调点对应编号         If lyr.Selection.Count > 0 Then                 Set oStyle = New style         oStyle.TextFont.Size = 12         oStyle.TextFont.Bold = True         oStyle.SymbolFontColor = vbWhite         oStyle.TextFontBackColor = vbBlue         oStyle.TextFontOpaque = True        ‘标注的样式为蓝底白字         Map1.Annotations.AddText(rs(showfield), lyr.Selection(1).CenterX, lyr.Selection(1).CenterY, miPositionTL).Graphic.style = oStyle                   End If       End If     Else      MsgBox "请先添加数据集!"      Exit Sub     End If          Set ds = Nothing     Set rvs = Nothing     rs.MoveNext  Loop While Not rs.EOF   Map1.AutoRedraw = True   Else    MsgBox "无法显示数据,请检查数据是否为空?"   End If   rs.Close   Set rs = Nothing  CnShowData.Close  Set CnShowData = Nothing End Sub 9 删除专题图   a,隐藏专题图    ds.Themes("trafficflupiebar").Visible = False   b,彻底删除    专题图是与数据集有关的,所以要先指出数据集     Dim ds As MapXLib.Dataset     For Each ds In Map1.DataSets     ds.Themes.RemoveAll     Next 10全层显示    Set fMainForm.Map1.NumericCoordSys = fMainForm.Map1.DisplayCoordSys         If LayerCombo.Text = "所有图层" Then         Set fMainForm.Map1.Bounds = fMainForm.Map1.Layers.Bounds     Else         Dim LayerName As String         LayerName = LayerCombo.Text         Set fMainForm.Map1.Bounds = fMainForm.Map1.Layers(LayerName).Bounds     End If  11改变地图比例,中心点    fMainForm.Map1.ZoomTo  ViewZoom, ViewX, ViewY‘ViewZoom地图比例;ViewX, ViewY是中心点 12 查找图元    mapx查找地图上的图元有多种方法   a, FindObj.Search     这种方法在用的时候有局限性:数据集必须要有索引,查找的字段类型不能是10进制类型(可能还有其它的类型,忘了),否则在图上找不到。      Set FindObj = fMainForm.Map1.Layers(LayerCombo.Text).Find     Set FindObj.FindDataset = fMainForm.Map1.DataSets(LayerCombo.Text & " dataset")     Set FindObj.FindField = FindObj.FindDataset.Fields(FieldCombo.Text)     Set FoundFeature = FindObj.Search(FindText.Text) If FoundFeature.FindRC Mod 10 = 1 Or FoundFeature.FindRC Mod 10 = 2 Then               fMainForm.Map1.Layers(LayerCombo.Text).Selection.Add FoundFeature         fMainForm.Map1.AutoRedraw = False         fMainForm.Map1.CenterX = FoundFeature.CenterX         fMainForm.Map1.CenterY = FoundFeature.CenterY    End If   b,SQL语句方法 Dim ftrs As MapXLib.Features Dim lyr As Layer Dim i As Integer  Set lyr = fMainForm.Map1.Layers(RoadlyrName)  Dim strs As String  strs = Trim("路线编码 = " + Chr(34) + ComRoadID.List(ComRoadID.ListIndex) + Chr(34))‘在值前面加双引号如:ID="001",         观测点名称 like "%天平庄"   Set ftrs = lyr.Search(strs)   lyr.Selection.ClearSelection  lyr.Selection.Add ftrs  If ftrs.Count > 0 Then  fMainForm.Map1.CenterX = ftrs.Item(1).CenterX  fMainForm.Map1.CenterY = ftrs.Item(1).CenterY  End If 13显示鼠标当前的经纬度  Private Sub Map1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)       Dim MX As Double, MY As Double       Map1.ConvertCoord x, y, MX, MY, 1             Text1.Item(1).Caption = "当前位置"         Text1.Item(2).Caption = "东经 " & Format(MX, "###0.0000") + ",北纬 " + Format(MY, "###0.0000")                        Text1.Item(3).Caption = " 当前图层"         Text1.Item(4).Caption = Map1.Layers(1).Name End Sub 14自动滚屏  Private Sub Map1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)  If mnuMoveCenter.Checked = True Then     If x > Map1.MapScreenWidth - 10 Then         Map1.CenterX = Map1.CenterX + 0.05         Map1.Refresh         Else         If x < 10 Then         Map1.CenterX = Map1.CenterX - 0.05         Map1.Refresh         Else         If y > Map1.MapScreenHeight - 10 Then         Map1.CenterY = Map1.CenterY - 0.05         Map1.Refresh         Else         If y < 10 Then         Map1.CenterY = Map1.CenterY + 0.05         Map1.Refresh         End If         End If         End If         End If End If  End Sub 15测距和测面积 Private Sub Form_Load()   Map1.CreateCustomTool PolyRulerToolID, miToolTypePoly, miSizeAllCursor     Map1.CreateCustomTool PolyAreaToolID, miToolTypePolygon, miSelectRegionMinusCursor End Sub  Private Sub Map1_PolyToolUsed(ByVal ToolNum As Integer, ByVal flags As Long, ByVal Points As Object, ByVal bShift As Boolean, ByVal bCtrl As Boolean, EnableDefault As Boolean)     If ToolNum = PolyRulerToolID Then         Dim i As Integer         Dim DistanceSoFar As Double         Map1.MapUnit = RulerUnit         DistanceSoFar = 0#         If Points.Count > 1 Then             For i = 2 To Points.Count                 DistanceSoFar = DistanceSoFar + Map1.Distance(Points.Item(i).x, Points.Item(i).y, Points.Item(i - 1).x, Points.Item(i - 1).y)             Next         End If         If flags = miPolyToolEnd Then             'First, clear the status bar                         Text1.Item(4).Caption = ""             MsgBox "距离: " & DistanceSoFar & " " & RulerUnitString         Else             Text1.Item(3).Caption = "距离"              Text1.Item(4).Caption = DistanceSoFar & " " & RulerUnitString         End If     End If     If ToolNum = PolyAreaToolID Then     '面积           Map1.AreaUnit = miUnitSquareKilometer     On Error Resume Next     Dim apolygoN As New MapXLib.Feature     Dim ax As Double     If (Points.Count > 2) Then     Set apolygoN = New Feature     Set apolygoN = Map1.FeatureFactory.CreateRegion(Points)     ax = apolygoN.Area     MsgBox "面积: " & ax     End If         End If End Sub 1如何修改柱状专题图的样式? Map1.DataSets.Item(DsName).Themes("trafficflubar").Properties.Size = BarSize Map1.DataSets.Item(DsName).Themes("trafficflubar").Properties.BarWidth = BarWidth Map1.DataSets.Item(DsName).Themes("trafficflubar").ThemeProperties.MultivarCategories.Item(1).style.RegionColor = SmallTruck_Color 2如何修改饼状专题图的样式? Map1.DataSets.Item(DsName).Themes("trafficflupiebar").Properties.Size = PieBarSize 'Map1.DataSets.Item(DsName).Themes("trafficflupiebar").Properties.Width = PieBarWidth Map1.DataSets.Item(DsName).Themes("trafficflupiebar").ThemeProperties.MultivarCategories.Item(1).style.RegionColor = SmallTruck_Color 3如何修改标注的样式?  Set oStyle = New MapXLib.style         oStyle.TextFont.Size = 12         oStyle.TextFont.Bold = True         oStyle.SymbolFontColor = vbWhite         oStyle.TextFontBackColor = vbBlue         oStyle.TextFontOpaque = True              Map1.Annotations.AddText(rs(showfield), lyr.Selection(1).CenterX, lyr.Selection(1).CenterY, 3).Graphic.style = oStyle         (白字黑底)
/
本文档为【gis二次开发】,请使用软件OFFICE或WPS软件打开。作品中的文字与图均可以修改和编辑, 图片更改请在作品中右键图片并更换,文字修改请直接点击文字进行修改,也可以新增和删除文档中的内容。
[版权声明] 本站所有资料为用户分享产生,若发现您的权利被侵害,请联系客服邮件isharekefu@iask.cn,我们尽快处理。 本作品所展示的图片、画像、字体、音乐的版权可能需版权方额外授权,请谨慎使用。 网站提供的党政主题相关内容(国旗、国徽、党徽..)目的在于配合国家政策宣传,仅限个人学习分享使用,禁止用于任何广告和商用目的。

历史搜索

    清空历史搜索