[讨论]AE中mapcontrol中右键菜单的实现

请问，有没有人在AE里做过mapcontrol的右键菜单，这个菜单不只是控制显示方面的，还能根据点选位置的不同，来调出相应的shp文件。谢谢

非常感谢kisssy斑竹的帮助，现在代码基本上完成了，写出来，希望对想要实现这个功能的人有帮助：

Private Sub MapControl1_OnMouseDown(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long, ByVal pageX As Double, ByVal pageY As Double)
   '右键弹出菜单
 Dim m_pMapControl As IMapControl3
 Dim pActiveView As IActiveView
 Dim pPoint As IPoint
 Dim pFeature As IFeature
 Dim pLayer As ILayer
 Dim QuickAdd As ICommand
 'Dim QuickAdd1 As ICommand
 Dim strTownName As String
 
 
 If Button = vbRightButton Then
 
     Set pActiveView = MapControl1.ActiveView.FocusMap

     Set pPoint = pActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(x, y)
 
     Set pFeature = FindFeature(0.0001, pPoint, MapControl1.ActiveView.FocusMap)  ' 调用findfeature过程
     'Set pLayer = m_pMapControl.CustomProperty
     If pFeature Is Nothing Then Exit Sub
     
       
     strTownName = CStr(pFeature.Value(2))
     Set QuickAdd = New ShotcutAdd
     'Set QuickAdd1 = New ShotcutAdd
     TownName = strTownName
     MapName = "土地利用现状图"
     'MapName1 = "养分图"
     
 
     Set m_pToolbarMenu = New ToolbarMenu
     m_pToolbarMenu.AddItem QuickAdd, , , , esriCommandStyleTextOnly
     'm_pToolbarMenu.AddItem QuickAdd1, , , , esriCommandStyleTextOnly
     m_pToolbarMenu.PopupMenu x, y, MapControl1.hwnd
   
 End If
   
End Sub

下面是findfeature函数：

Public Function FindFeature(SearchTol As Double, pPoint As IPoint, pMap As IMap) As IFeature
 On Error GoTo Error_h:
 Dim pEnvelope As IEnvelope
 Dim pSpatialFilter As ISpatialFilter
 Dim pEnumLayer As IEnumLayer
 Dim pFeatureLayer As IFeatureLayer
 Dim pFeatureClass As IFeatureClass
 Dim pFeatureCursor As IFeatureCursor
 Dim pFeature As IFeature
 Dim pUID As New UID
 Dim ShapeFieldName As String

 
 If pMap.LayerCount = 0 Then Exit Function
 
 'Expand the points envelope to give better search results
 Set pEnvelope = pPoint.Envelope
 pEnvelope.Expand SearchTol, SearchTol, False
 
 'Create a new spatial filter and use the new envelope as the geometry
 Set pSpatialFilter = New SpatialFilter
 Set pSpatialFilter.Geometry = pEnvelope
 pSpatialFilter.SpatialRel = esriSpatialRelIntersects

  Dim i As Integer
  For i = 0 To pMap.LayerCount - 1
  If pMap.Layer(i).Name = "乡镇区划图" Then
  Set pFeatureLayer = pMap.Layer(i)
  Exit For
  End If
  Next i
 
 'Only search the selectable layers
   If pFeatureLayer.Selectable Then
'      ShapeFieldName = pFeatureLayer.FeatureClass.ShapeFieldName
'      Set pSpatialFilter.OutputSpatialReference(ShapeFieldName) = pMap.SpatialReference
     pSpatialFilter.GeometryField = "Shape"

     Set pFeatureClass = pFeatureLayer.FeatureClass
     Set pFeatureCursor = pFeatureClass.Search(pSpatialFilter, False)  'Do the search
     Set pFeature = pFeatureCursor.NextFeature  'Get the first feature
     If Not pFeature Is Nothing Then
       Set FindFeature = pFeature  'Exit if feature is valid
       'Exit Do
     End If
   End If
 

Error_h:
End Function

下面是bas1.bas模块里的定义：

Public TownName As String
Public MapName As String

下面是shotcutadd类模块的代码：

Private m_pHookHelper As IHookHelper    ''for getting Focusmap,ActiveView

Implements esriSystemUI.ICommand

Private Sub Class_Initialize()

Set m_pHookHelper = New HookHelper

End Sub

Private Sub Class_Terminate()

 Set m_pHookHelper = Nothing

End Sub

Private Property Get ICommand_Enabled() As Boolean
   
   ' TOD Add your implementation here
   ICommand_Enabled = True
   
End Property

Private Property Get ICommand_Checked() As Boolean
   
   ' TOD Add your implementation here
   ' ICommand_Checked =
   
End Property

Private Property Get ICommand_Name() As String
   
   ' TOD Add your implementation here
    ICommand_Name = "ShotcutAdd"
   
End Property

Private Property Get ICommand_Caption() As String
   
   ' TOD Add your implementation here
    ICommand_Caption = TownName + MapName
   
End Property

Private Property Get ICommand_Tooltip() As String
   
   ' TOD Add your implementation here
   ' ICommand_Tooltip =
   
End Property

Private Property Get ICommand_Message() As String
   
   ' TOD Add your implementation here
   ' ICommand_Message =
   
End Property

Private Property Get ICommand_HelpFile() As String
   
   ' TOD Add your implementation here
   ' ICommand_HelpFile =
   
End Property

Private Property Get ICommand_HelpContextID() As Long
   
   ' TOD Add your implementation here
   ' ICommand_HelpContextID =
   
End Property

Private Property Get ICommand_Bitmap() As esriSystem.OLE_HANDLE
   
   ' TOD Add your implementation here
   ' ICommand_Bitmap =
   
End Property

Private Property Get ICommand_Category() As String
   
   ' TOD Add your implementation here
   ' ICommand_Category =
   
End Property

Private Sub ICommand_OnCreate(ByVal hook As Object)
   
   ' TOD Add your implementation here
   Set m_pHookHelper.hook = hook

   
End Sub

Private Sub ICommand_OnClick()

 Const allpath As String = "E:\江津\行政区划图\"
 Dim pWorkspaceFactory As IWorkspaceFactory
 Dim pFeatureWorkSpace As IFeatureWorkspace
 Dim pFeatureLayer As IFeatureLayer
 Dim pMap As IMap
 Dim path1 As String
 Dim filename As String
 'Dim tfile As String

 'Create a new ShapefileWorkspaceFactory object and open a shapefile folder
 Set pWorkspaceFactory = New ShapefileWorkspaceFactory
 path1 = allpath ; TownName
 Set pFeatureWorkSpace = pWorkspaceFactory.OpenFromFile(path1, 0)

 'Create a new FeatureLayer and assign a shapefile to it
 Set pFeatureLayer = New FEATURELAYER
 filename = TownName ; MapName
 Set pFeatureLayer.FeatureClass = pFeatureWorkSpace.OpenFeatureClass(filename)
 pFeatureLayer.Name = pFeatureLayer.FeatureClass.AliasName

 'Add the FeatureLayer to the focus map
 Form1.MapControl1.AddLayer pFeatureLayer
 
End Sub

改来改去还是一堆的错误，现在我把类模块改成shotcutadd嘛，然后用Dim QuickAdd As ICommand，结果还是提示一堆的错误，说

QuickAdd.TownName = strTownName

QuickAdd.MapName = "地形图"           找不到方法和数据成员

程序报什么错呢？

  下面两句也不对，怎么能用Set呢？  去掉Set

Set ShotcutAdd.TownName = strTownName

     Set ShotcutAdd.MapName = "地形图"

哪里出错呢？

不过Set ShotcutAdd = New ShotcutAdd这样不好吧，

变量名最好不要跟类模块名一样。

谢谢斑竹，谢谢，今天照你的思路改过了，调试了一下午，到现在还没有出来，你看看我写的对不对？

Private Sub MapControl1_OnMouseDown(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long, ByVal pageX As Double, ByVal pageY As Double)
   '右键弹出菜单
 Dim m_pMapControl As IMapControl3
 Dim pActiveView As IActiveView
 Dim pPoint As IPoint
 Dim pFeature As IFeature
 Dim pLayer As ILayer
 Dim ShotcutAdd As ICommand
 
 If Button = vbRightButton Then
 
     Set pActiveView = MapControl1.ActiveView.FocusMap

     Set pPoint = pActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(x, y)
 
     Set pFeature = FindFeature(pMxDoc.SearchTolerance, pPoint, MapControl1.ActiveView.FocusMap)  ' 调用findfeature过程

     Set pLayer = m_pMapControl.CustomProperty
 
     Set strTownName = pFeature.Value(2)
 
     Set ShotcutAdd = New ShotcutAdd

     Set ShotcutAdd.TownName = strTownName

     Set ShotcutAdd.MapName = "地形图"
 
     m_pToolbarMenu.AddItem ShotcutAdd, , , , esriCommandStyleTextOnly
 
     m_pToolbarMenu.PopupMenu x, y, MapControl1.hwnd
   
 End If
   
End Sub

下面是FindFeature过程

Public Function FindFeature(SearchTol As Double, pPoint As IPoint, pMap As IMap) As IFeature
 On Error GoTo Error_h:
 Dim pEnvelope As IEnvelope
 Dim pSpatialFilter As ISpatialFilter
 Dim pEnumLayer As IEnumLayer
 Dim pFeatureLayer As IFeatureLayer
 Dim pFeatureClass As IFeatureClass
 Dim pFeatureCursor As IFeatureCursor
 Dim pFeature As IFeature
 Dim pUID As New UID
 Dim ShapeFieldName As String
 Dim m_pMapControl As IMapControl3
 Dim pLayer As ILayer

 
 If pMap.LayerCount = 0 Then Exit Function
 
 'Expand the points envelope to give better search results
 Set pEnvelope = pPoint.Envelope
 pEnvelope.Expand SearchTol, SearchTol, False
 
 'Create a new spatial filter and use the new envelope as the geometry
 Set pSpatialFilter = New SpatialFilter
 Set pSpatialFilter.Geometry = pEnvelope
 pSpatialFilter.SpatialRel = esriSpatialRelIntersects
 Set pLayer = m_pMapControl.CustomProperty

  Dim i As Integer
  For i = 0 To pMap.LayerCount - 1
  If pMap.Layer(i).Name = pLayer.Name Then
  Set pFeatureLayer = pMap.Layer(i)
  Exit For
  End If
  Next i
 
 'Only search the selectable layers
   If pFeatureLayer.Selectable Then
     ShapeFieldName = pFeatureLayer.FeatureClass.ShapeFieldName
     Set pSpatialFilter.OutputSpatialReference(ShapeFieldName) = pMap.SpatialReference
     pSpatialFilter.GeometryField = pFeatureLayer.FeatureClass.ShapeFieldName
     Set pFeatureClass = pFeatureLayer.FeatureClass
     Set pFeatureCursor = pFeatureClass.Search(pSpatialFilter, False)  'Do the search
     Set pFeature = pFeatureCursor.NextFeature  'Get the first feature
     If Not pFeature Is Nothing Then
       Set FindFeature = pFeature  'Exit if feature is valid
       'Exit Do
     End If
   End If
 

Error_h:
End Function

你说的我添加到类模块去了，名字叫shotcutadd

Private Sub ICommand_OnClick()

 Const allpath As String = "E:\江津\行政区划图\"
 Dim pWorkspaceFactory As IWorkspaceFactory
 Dim pFeatureWorkspace As IFeatureWorkspace
 Dim pFeatureLayer As IFeatureLayer
 Dim pMap As IMap
 Dim path1 As String
 Dim filename As String
 Dim tfile As String

 'Create a new ShapefileWorkspaceFactory object and open a shapefile folder
 Set pWorkspaceFactory = New ShapefileWorkspaceFactory
 path1 = allpath ; tfile
 Set pFeatureWorkspace = pWorkspaceFactory.OpenFromFile(path1, 0)

 'Create a new FeatureLayer and assign a shapefile to it
 Set pFeatureLayer = New FEATURELAYER
 filename = tfile ; m_MapName
 Set pFeatureLayer.FeatureClass = pFeatureWorkspace.OpenFeatureClass(filename)
 pFeatureLayer.Name = pFeatureLayer.FeatureClass.AliasName

 'Add the FeatureLayer to the focus map
 MapControl1.AddLayer pFeatureLayer
 
End Sub

当然不用那样吧。我不知道具体情况怎样，但是程序的框架应该：

1、一个Command类模块（假设叫MyCommand）

Implements esriSystemUI.ICommand

Private m_pHookHelper As IHookHelper    ''for getting Focusmap,ActiveView
Private m_TownName as string              '乡镇名
Private m_MapName as string               '**图名

Private Sub Class_Initialize()

Set m_pHookHelper = New HookHelper

End Sub

Private Sub Class_Terminate()

 Set m_pHookHelper = Nothing

End Sub

Public Property Get TownName() As String
  TownName =m_TownName
End Property

Public Property Let TownName(ByVal NewValue As String)
 
  m_TownName = NewValue
End Property

Public Property Get MapName() As String
  MapName =m_MapName
End Property

Public Property Let MapName(ByVal NewValue As String)
 
  m_MapName = NewValue
End Property

Private Property Get ICommand_Enabled() As Boolean
   
   ' TOD Add your implementation here
   ICommand_Enabled =True
   
End Property

Private Property Get ICommand_Checked() As Boolean
   
   ' TOD Add your implementation here
   ' ICommand_Checked =
   
End Property

Private Property Get ICommand_Name() As String
   
   ' TOD Add your implementation here
    ICommand_Name = "MyCommand"
   
End Property

Private Property Get ICommand_Caption() As String
   
   ' TOD Add your implementation here
    ICommand_Caption = m_Town+m_MapType
   
End Property

Private Property Get ICommand_Tooltip() As String
   
   ' TOD Add your implementation here
   ' ICommand_Tooltip =
   
End Property

Private Property Get ICommand_Message() As String
   
   ' TOD Add your implementation here
   ' ICommand_Message =
   
End Property

Private Property Get ICommand_HelpFile() As String
   
   ' TOD Add your implementation here
   ' ICommand_HelpFile =
   
End Property

Private Property Get ICommand_HelpContextID() As Long
   
   ' TOD Add your implementation here
   ' ICommand_HelpContextID =
   
End Property

Private Property Get ICommand_Bitmap() As esriSystem.OLE_HANDLE
   
   ' TOD Add your implementation here
   ' ICommand_Bitmap =
   
End Property

Private Property Get ICommand_Category() As String
   
   ' TOD Add your implementation here
   ' ICommand_Category =
   
End Property

Private Sub ICommand_OnCreate(ByVal hook As Object)
   
   ' TOD Add your implementation here
   Set m_pHookHelper.hook = hook

   
End Sub

Private Sub ICommand_OnClick()
   
   ' TOD Add your implementation here
   ' TOD Add your implementation here
   ' TOD Add your implementation here
   ' TOD Add your implementation here
   ' TOD Add your implementation here

End Sub

2、动态添加菜单时

通过属性获得乡镇名,保存在strTownName变量中

  Dim MyCommand1 As ICommand
  Set MyCommand1 = New MyCommand

  MyCommand1.TownName=strTownName

  MyCommand1.MapName="地形图"
  m_pToolbarMenu.AddItem MyCommand1, , , , esriCommandStyleTextOnly

  Set MyCommand1 = New MyCommand

  MyCommand1.TownName=strTownName

  MyCommand1.MapName="土壤图"
  m_pToolbarMenu.AddItem MyCommand1, , , , esriCommandStyleTextOnly

.....

.....

不知道是否可行，注意在ICommand_OnClick事件中添加你自己的代码

楼上的斑竹大哥，能不能具体做一个例子出来，实在不好意思，我还是不大明白，谢谢，谢谢了

还有就是m_pToolbarMenu.AddItem后面要做出来接近10个可选择性的添加shp的菜单，是把这个命令做到类模块里吗？但是，那样的话不是要做接近30个乡镇不同的类模块？