Листин взят из Help-а, по крайней мере на версии 8.3 работает.
Правой клавишей мыша тыкаем в любое место на панели инструментов, в
контекстном меню выбираем Customize... далее вкладку Commands в ней
выбираем UIControls, внизу формы вбираем где будет храниться инструмент
(либо в текущем проекте, либо в Normal.mxt - т.е. будет по умолчанию
врубаться в любом новом проекте), далее кнопка New UIControl, далее
выбираем из 4-ех вариантов нужный (в данном случае UIToolControl),
давим Create, появляется новый инструмент со стандартным названием
(название соответственно можно поменять, если есть необходимость), далее
давим левой кнопкой мыши на название и тянем в любое место на панели
инструментов, далее правой кнопкой мыши на новый инструмент и выбираем
View Source - переходим в редактор VBA, далее копируем низлежащий текст
программы и испытываем оную.
В результате тычка левой клавишей мыши на некоторый объект на карте
должна выползти месседжа о названии слоя в коем данный объект находится
и некоторое его имя или идентификатор.
Соответственно в карте должен быть хотя бы один слой !!!
Private Sub UIToolControl1_MouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)
Dim pMxApp As IMxApplication
Dim pMxDoc As IMxDocument
Dim pMap As IMap
Dim pIdentify As IIdentify
Dim pIDArray As IArray
Dim pFeatIdObj As IFeatureIdentifyObj
Dim pIdObj As IIdentifyObj
Dim tol As Long
Dim pEnv As IEnvelope
Dim r As tagRECT
Set pMxApp = Application
Set pMxDoc = ThisDocument
Set pMap = pMxDoc.FocusMap
Set pIdentify = pMap.Layer(0)
tol = pMxDoc.SearchTolerancePixels
'consruct a small rectangle out of the x,y coord and the document's pixel tolerance
r.Left = x - tol * 2 'upper left x, top left is 0,0
r.Top = y - tol * 2 'upper left y, top left is 0,0
r.Right = x + tol * 2 'lower right x, top left is 0,0
r.bottom = y + tol * 2 'lower right y, top left is 0,0
'Tranform the device rectange into a geographic rectangle via the display transformation
Set pEnv = New Envelope
pMxApp.Display.DisplayTransformation.TransformRect pEnv, r, esriTransformPosition + esriTransformToMap
'setup the spatial reference on the newly hydrated envelope
Set pEnv.SpatialReference = pMap.SpatialReference
'identify with the envelope
Set pIDArray = pIdentify.Identify(pEnv)
'Get the FeatureIdentifyObject
If Not pIDArray Is Nothing Then
Set pFeatIdObj = pIDArray.Element(0)
Set pIdObj = pFeatIdObj
pIdObj.Flash pMxApp.Display
'Report info from FeatureIdentifyObject
MsgBox "Слой: " & pIdObj.Layer.Name & vbNewLine & "Объект: " & pIdObj.Name
Else
MsgBox "Не выбрано ни одного объекта "
End If
End Sub
Если заинтересует далее, то лучше по электронке, а не в форуме, дабы на засорять эфир ...
ldokov@mail.ru - Денис