Monday, November 9, 2009

Data Stamp for ArcGIS ArcMap_UIToolControl1

Private Sub UIToolControl1_MouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)

'Attach this script to a UITool Control
Dim theDate
Dim theTime
Dim pTemplates As ITemplates
Dim lTempCount As Long
Dim strDocPath As String
Dim pMxDoc As IMxDocument
Dim pPageLayout As IPageLayout
Dim pActiveView As IActiveView
Dim pGraphicsContainer As IGraphicsContainer
Dim pTextElement As ITextElement
Dim pElement As IElement
Dim pPoint As IPoint

Set pMxDoc = Application.Document
Set pPageLayout = pMxDoc.PageLayout
Set pActiveView = pPageLayout
Set pGraphicsContainer = pPageLayout

'check that Arcmap is in layout view

If Not TypeOf pMxDoc.ActiveView Is IPageLayout Then
MsgBox "This tool works only in layout View", vbOKOnly
Exit Sub
End If

Set pTextElement = New TextElement
Set pElement = pTextElement
theDate = Date
theTime = Time
Set pTemplates = Application.Templates
lTempCount = pTemplates.Count

' The document is always the last item
strDocPath = pTemplates.Item(lTempCount - 1)

Set pPoint = pActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(x, y)
pTextElement.Text = "Copyright EbenGIS & Associates" & vbCrLf & _
"This map (" & strDocPath & ")" & vbCrLf & _
"was produced on" & " " & theDate & " " & "at" & " " & theTime
pElement.Geometry = pPoint
pGraphicsContainer.AddElement pElement, 0
pActiveView.PartialRefresh esriViewGraphics, Nothing, Nothing

End Sub


No comments:

Post a Comment