如何在Page Layout上添加Scale bar

如何在Page Layout上添加Scale bar,第1张

本例要实现的功能是以鼠标在Page Layout上画的Envelope为范围在Pagelayout增加一个跟第一个层相关联的图例。

要实现本例的功能首先需要在PageLayout上创建一个Legend元素,然后再设置该元素的属性,其中用到了两个主要的接口:ILegend和IlegendItem。

ILegend用来控制Legend(图例)。以下是该接口成员的介绍:

Layer:实现与相关层的关联;

Columns:图例以几列显示;

ShowDescription 、ShowHeading、ShowLabels、ShowLayerName: 分别表示描述、标题、分类、层名称是否显示;

IlegendItem用来设置Legend的风格。以下是该接口成员的介绍:

AddItem :在图例的最后添加一项;

ClearItem:清除所有项;

Title:设置标题。

? 程序说明

函数CreateLegend根据传入的pExtent参数在PageLayout上添加一个Legend元素。

? 代码

Private Sub UIToolControl1_MouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, _

ByVal y As Long)

Dim pMxDocument As IMxDocument

Dim pActiveView As IActiveView

Dim pEnvelope As IEnvelope

Dim pFeatureLayer As IFeatureLayer

Dim pRubberBand As IRubberBand

On Error GoTo ErrorHandler

Set pMxDocument = ThisDocument

'确保AcrMap在Layout模式下

'确保AcrMap中有数据

If Not pMxDocument.ActiveView Is pMxDocument.PageLayout Or pMxDocument.FocusMap.LayerCount = 0 Then

Exit Sub

End If

'初始设定

Set pActiveView = pMxDocument.PageLayout

Set pRubberBand = New RubberEnvelope

'IRubberBand接口用于画Envelope,Polygon等

Set pEnvelope = pRubberBand.TrackNew(pMxDocument.ActiveView.ScreenDisplay, Nothing)

Set pFeatureLayer = pMxDocument.FocusMap.Layer(0)

CreateLegend pEnvelope, pFeatureLayer, pActiveView

pActiveView.Refresh

Exit Sub

ErrorHandler:

MsgBox Err.Description

End Sub

Public Sub CreateLegend(pExtent As IEnvelope, pFeatureLayer As IFeatureLayer, _

pActiveView As IActiveView)

Dim pMapFrame As IMapFrame

Dim pMapSurroundF As IMapSurroundFrame

Dim pMapSurround As IMapSurround

Dim pLegend As ILegend

Dim pLegendItem As ILegendItem

Dim pElement As IElement

Dim pAreaLayer As IFeatureLayer

Dim pTextSymbol As ITextSymbol

Dim pFillSymbol As IFillSymbol

Dim pLineSymbol As ILineSymbol

Dim pColor As IColor

Dim pSymbolBackground As ISymbolBackground

Dim pUID As New UID

On Error GoTo ErrorHandler

If pFeatureLayer Is Nothing Then Exit Sub

If pActiveView Is Nothing Then Exit Sub

If Not TypeOf pActiveView Is IPageLayout Then Exit Sub

'得到MapFrame

Set pMapFrame = pActiveView.GraphicsContainer.FindFrame(pActiveView.FocusMap)

pUID.Value = "esriCore.Legend"

Set pMapSurroundF = pMapFrame.CreateSurroundFrame(pUID, Nothing)

'创建底图Symbol

Set pSymbolBackground = New esriCore.SymbolBackground

Set pFillSymbol = New esriCore.SimpleFillSymbol

Set pLineSymbol = New esriCore.SimpleLineSymbol

Set pColor = New esriCore.RgbColor

pColor.RGB = RGB(255, 255, 255)

pLineSymbol.Color = pColor

pFillSymbol.Color = pColor

pFillSymbol.Outline = pLineSymbol

pSymbolBackground.FillSymbol = pFillSymbol

pMapSurroundF.Background = pSymbolBackground

Set pElement = pMapSurroundF

pElement.Geometry = pExtent

Set pMapSurround = pMapSurroundF.MapSurround

Set pLegend = pMapSurround

'创建一个水平的LegendItem

Set pLegendItem = New esriCore.HorizontalLegendItem

'设置LegendItem的相关层和列数

With pLegendItem

Set .Layer = pFeatureLayer

.Columns = 1

.ShowDescriptions = True

.ShowHeading = True

.ShowLabels = True

.ShowLayerName = True

End With

'先清除所有的LegendItem

pLegend.ClearItems

'在Legend上添加一个LegendItem

With pLegend

.AddItem pLegendItem

.Title = "New Legend"

End With

pActiveView.GraphicsContainer.AddElement pElement, 0

Exit Sub

ErrorHandler:

MsgBox Err.Description

End Sub

这次我们用到的软件是ImageJ。

首先,通过File/Open打开需要处理的图片,然后使用放大工具(工具栏第10个,快捷键:Ctrl+“+”放大,Ctrl+“-”缩小)放大图片,重点是放大标尺区域,便于 *** 作。

接下来是 设置标尺的真实单位 ,也就是将图片的像素尺寸(pixels)换算为实际的物理尺寸,如这里的微米。

方法是根据照片中的标尺,用直线工具画一条与标尺等长的线段,然后通过Analyze/Set Scale,设置换算关系,(如果选择“Global“,接下来的照片都以此标准进行换算,直到关闭软件),点OK 完成设置。注意,虽然单位输入的是“um”,但imageJ会自动转换为“_m”,这一点非常人性化!


欢迎分享,转载请注明来源:内存溢出

原文地址: https://outofmemory.cn/bake/7974439.html

(0)
打赏 微信扫一扫 微信扫一扫 支付宝扫一扫 支付宝扫一扫
上一篇 2023-04-12
下一篇 2023-04-12

发表评论

登录后才能评论

评论列表(0条)

保存