Public Sub
AddMapSurrounds()
Dim
pMxDocAs
IMxDocument
Dim
pActiveViewAs
IActiveView
Dim
pEnvAs
IEnvelope
Dim
pIDAs New
UID
Dim
pMapSurroundAs
IMapSurround
Dim
pMarkerNorthArrowAs
IMarkerNorthArrow
Dim
pCharacterMarkerSymbolAs
ICharacterMarkerSymbol
Set
pMxDoc = Application.Document
Set
pActiveView = pMxDoc.PageLayout
Set
pEnv =New
Envelope
'Add a north arrow
pEnv.PutCoords 0.2, 0.2, 1, 1
pID.Value = "esriCarto.MarkerNorthArrow"
Set
pMapSurround = CreateSurround(pID, pEnv, "North Arrow", pMxDoc.FocusMap, pMxDoc.PageLayout)
'Change out the default north arrow
Set
pMarkerNorthArrow = pMapSurround'QI
Set
pCharacterMarkerSymbol = pMarkerNorthArrow.MarkerSymbol'clones the symbol
pCharacterMarkerSymbol.CharacterIndex = 200'change the symbol
pMarkerNorthArrow.MarkerSymbol = pCharacterMarkerSymbol'set it back
'Add a legend
'In this case just use the default legend
pEnv.PutCoords 1, 1, 3.4, 2.4
pID.Value = "esriCarto.Legend"
Set
pMapSurround = CreateSurround(pID, pEnv, "Legend", pMxDoc.FocusMap, pMxDoc.PageLayout)
'Refresh the graphics
pActiveView.PartialRefresh esriViewGraphics,Nothing
,Nothing
CreateSurround(pID
End Sub
Private FunctionAs
UID, pEnvAs
IEnvelope, strNameAs String
, _
pMapAs
IMap, pPageLayoutAs
IPageLayout)As
IMapSurround
Dim
pGraphicsContainerAs
IGraphicsContainer
Dim
pActiveViewAs
IActiveView
Dim
pMapSurroundFrameAs
IMapSurroundFrame
Dim
pMapSurroundAs
IMapSurround
Dim
pMapFrameAs
IMapFrame
Dim
pElementAs
IElement
'MapSurrounds are held in a MapSurroundFrame
'MapSurroundFrames are related to MapFrames
'MapFrames hold Maps
Set
pGraphicsContainer = pPageLayout
Set
pMapFrame = pGraphicsContainer.FindFrame(pMap)
Set
pMapSurroundFrame = pMapFrame.CreateSurroundFrame(pID,Nothing
)
pMapSurroundFrame.MapSurround.Name = strName
'Set the geometry of the MapSurroundFrame to give it a location
'Activate it and add it to the PageLayout's graphics container
Set
pElement = pMapSurroundFrame
Set
pActiveView = pPageLayout
pElement.Geometry = pEnv
pElement.Activate pActiveView.ScreenDisplay
'Allow the legend frame size to be altered after the legend has been
'added to the GraphicsContainer
Dim
PTrackAs
ITrackCancel
Set
PTrack =New
CancelTracker
pElement.Draw pActiveView.ScreenDisplay, PTrack
pGraphicsContainer.AddElement pElement, 0
'Re-apply the change to the Legend MapSurroundFrame Geometry
pElement.Geometry = pEnv
Set
CreateSurround = pMapSurroundFrame.MapSurroundEnd Function
实现在PageLayout控件中添加了图例、指北针或比例
最新推荐文章于 2021-05-08 11:28:31 发布