Danni
I recently did something similar but I am at this stage a bit of a
hacker (as in I'm not very good at it).
I do not need to open to arcmap and then zoom as I already have it
open when I go to a particular zoom.
But to open it with a map use something like this:
fullpath2 = "D:\Data\crash\crash analysisBASIC.mxd"
Call ShellExecute(0, vbNullString, "D:\Data\crash\crash
analysisBASIC.mxd", vbNullString, fullpath2, 1)
The most 'dodgy' thing about what I have done is that it uses
clipboard to paste a string from Access and then ArcMap grabs this
string and uses it as a query, then zooms to what it finds.
In access have a text box with your query made: ie "LandID = 5000"
Then have a button with an event:
'Incase the user makes another copy by accident this button recopies
the query
'string to clipboard
txtSelectObjectsQuery.SetFocus
If IsNull(txtSelectObjectsQuery) = False Then
DoCmd.RunCommand acCmdCopy
Else
MsgBox "There must be text in the query text box to copy", _
vbExclamation + vbOKOnly + vbDefaultButton1, "No String
" & _
"to Copy!"
End If
Make a form in arcMap called frmQueryStringHolder and save it to
normal.mxd
Now on a button you have created in ArcMap:
Private Sub FindIntersection_Click()
Dim str As String
frmQueryStringHolder.txtSQLString.SetFocus
frmQueryStringHolder.txtSQLString.Text = ""
frmQueryStringHolder.txtSQLString.Paste
'MsgBox frmQueryStringHolder.txtSQLString.Text
Call ThisDocument1.FindIntersection(frmQueryStringHolde r.txtSQLString.Text)
End Sub
Now in a module named thisdocument1 put:
Option Explicit
Dim pMxApp As IMxApplication
Dim pMxDoc As IMxDocument
Private Declare Function sndPlaySound32 Lib "winmm.dll" Alias
"sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long)
As Long
Public Sub FindIntersection(strQuery As String)
On Error GoTo FindIntersectionError:
Set pMxApp = Application
Set pMxDoc = ThisDocument
Dim pMap As IMap
Set pMap = pMxDoc.FocusMap
Dim pFLayer As IFeatureLayer
'Set pFlayer = pMap.Layers(0)
Dim i As Integer
For i = 0 To pMap.LayerCount - 1
If pMap.Layer(i).Name = "IntersectLGA" Then
Set pFLayer = pMap.Layer(i)
End If
Next i
Dim pqfilter As IQueryFilter
Set pqfilter = New QueryFilter
pqfilter.WhereClause = strQuery
Debug.Print pqfilter.WhereClause
Dim pWS As IWorkspace
Dim pDS As IDataset
Set pDS = pFLayer.FeatureClass
Set pWS = pDS.Workspace
'Dim pFselSet As ISelectionSet
'Set pFselSet = pFlayer.FeatureClass.Select(pqfilter,
esriSelectionTypeHybrid, esriSelectionOptionNormal, pWS)
'Debug.Print pFselSet.Count
Dim pFSel As IFeatureSelection
Set pFSel = pFLayer
pFSel.SelectFeatures pqfilter, esriSelectionResultNew, False
Dim pSelSet As ISelectionSet
Set pSelSet = pFSel.SelectionSet
Dim pEnvelope As IEnvelope
Dim pFcurs As IFeatureCursor
Dim pFeat As IFeature
If pSelSet.Count > 1 Then
Dim pEnumGeom As IEnumGeometry
Dim pEnumGeomBind As IEnumGeometryBind
Set pEnumGeom = New EnumFeatureGeometry
Set pEnumGeomBind = pEnumGeom
pEnumGeomBind.BindGeometrySource Nothing, pSelSet
Dim pGeomFactory As IGeometryFactory
Set pGeomFactory = New GeometryEnvironment
Dim pGeom As IGeometry
Set pGeom = pGeomFactory.CreateGeometryFromEnumerator(pEnumGeo m)
pMxDoc.ActiveView.Extent = pGeom.Envelope
ElseIf pSelSet.Count = 1 Then
pSelSet.Search Nothing, True, pFcurs
Set pFeat = pFcurs.NextFeature
Set pEnvelope = pFeat.Extent
Debug.Print pEnvelope.Width
pEnvelope.Width = pEnvelope.Width + 1
pEnvelope.Height = pEnvelope.Height + 1
pEnvelope.Expand 50, 50, True
Debug.Print pEnvelope.Width
pMxDoc.ActiveView.Extent = pEnvelope
Else
MsgBox "error"
End If
pMxDoc.ActiveView.Refresh
'zoom out a little
Dim pActiveView As IActiveView
Dim pDisplayTransform As IDisplayTransformation
Dim pCenterPoint As IPoint
Set pActiveView = pMxDoc.FocusMap
Set pDisplayTransform =
pActiveView.ScreenDisplay.DisplayTransformation
Set pEnvelope = pDisplayTransform.VisibleBounds
'In this case, we could have set pEnvelope to IActiveView::Extent
'Set pEnvelope = pActiveView.Extent
Set pCenterPoint = New Point
pCenterPoint.X = ((pEnvelope.XMax - pEnvelope.XMin) / 2) +
pEnvelope.XMin
pCenterPoint.Y = ((pEnvelope.YMax - pEnvelope.YMin) / 2) +
pEnvelope.YMin
pEnvelope.Width = pEnvelope.Width * 1.1
pEnvelope.Height = pEnvelope.Height * 1.1
pEnvelope.CenterAt pCenterPoint
pDisplayTransform.VisibleBounds = pEnvelope
pActiveView.Refresh
FindIntersectionError:
If Err.Number = -2147467259 Then
MsgBox "The WHERE clause of the SQL statement comes from " & _
"clipboard. Please ensure the clipboard contains a valid " & _
"WHERE clause.", vbExclamation + vbOKOnly + _
vbDefaultButton1, "SQL Error"
Exit Sub
Else
'MsgBox "Error Number " & Err.Number & " - " & Err.Description
End If
Call sndPlaySound32("G:\RS&NM\RS\CRASH\RequestsDB\dogba rk4.wav", 0)
End Sub
You'll have to change the code as usual to suit your needs. Most
importantly set the layer from "IntersectLGA" to what your layers name
is. This code combine's the geometries of objects if more than one
object is selected. It also for fun plays a dog barking sound file so
we know its found it - Corny hey.
Good luck. It may get you by
Lincoln King
Sydney, Australia
"danit58" <da*****@tiscalinet.it> wrote in message news:<cj**********@lacerta.tiscalinet.it>...
Anyone use il software ESRI ArcView GIS?????
In a DB Access I store information about plot of land, house and related
ownership.
By click a button in a specific record, I want to open ESRI ArcView with a
specific view: the selected object in access, is selected in the map in view
Who help me???
By Dany
