|
阅读：6864回复：29
[讨论]AE中mapcontrol中右键菜单的实现
<P>请问，有没有人在AE里做过mapcontrol的右键菜单，这个菜单不只是控制显示方面的，还能根据点选位置的不同，来调出相应的shp文件。谢谢</P>
|
|
|
|
1楼#
发布于：2005-09-11 15:29
<P>非常感谢<FONT color=#ff0033>kisssy斑竹</FONT>的帮助，现在代码基本上完成了，写出来，希望对想要实现这个功能的人有帮助：</P>
<P>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)<BR> '右键弹出菜单<BR> Dim m_pMapControl As IMapControl3<BR> Dim pActiveView As IActiveView<BR> Dim pPoint As IPoint<BR> Dim pFeature As IFeature<BR> Dim pLayer As ILayer<BR> Dim QuickAdd As ICommand<BR> 'Dim QuickAdd1 As ICommand<BR> Dim strTownName As String<BR> <BR> <BR> If Button = vbRightButton Then<BR> <BR> Set pActiveView = MapControl1.ActiveView.FocusMap<BR> <BR> Set pPoint = pActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(x, y)<BR> <BR> Set pFeature = FindFeature(0.0001, pPoint, MapControl1.ActiveView.FocusMap) ' 调用findfeature过程<BR> 'Set pLayer = m_pMapControl.CustomProperty<BR> If pFeature Is Nothing Then Exit Sub<BR> <BR> <BR> strTownName = CStr(pFeature.Value(2))<BR> Set QuickAdd = New ShotcutAdd<BR> 'Set QuickAdd1 = New ShotcutAdd<BR> TownName = strTownName<BR> MapName = "土地利用现状图"<BR> 'MapName1 = "养分图"<BR> <BR> <BR> Set m_pToolbarMenu = New ToolbarMenu<BR> m_pToolbarMenu.AddItem QuickAdd, , , , esriCommandStyleTextOnly<BR> 'm_pToolbarMenu.AddItem QuickAdd1, , , , esriCommandStyleTextOnly<BR> m_pToolbarMenu.PopupMenu x, y, MapControl1.hwnd<BR> <BR> End If<BR> <BR>End Sub</P> <P><FONT color=#ff0033>下面是findfeature函数：</FONT></P> <P>Public Function FindFeature(SearchTol As Double, pPoint As IPoint, pMap As IMap) As IFeature<BR> On Error GoTo Error_h:<BR> Dim pEnvelope As IEnvelope<BR> Dim pSpatialFilter As ISpatialFilter<BR> Dim pEnumLayer As IEnumLayer<BR> Dim pFeatureLayer As IFeatureLayer<BR> Dim pFeatureClass As IFeatureClass<BR> Dim pFeatureCursor As IFeatureCursor<BR> Dim pFeature As IFeature<BR> Dim pUID As New UID<BR> Dim ShapeFieldName As String</P> <P><BR> <BR> If pMap.LayerCount = 0 Then Exit Function<BR> <BR> 'Expand the points envelope to give better search results<BR> Set pEnvelope = pPoint.Envelope<BR> pEnvelope.Expand SearchTol, SearchTol, False<BR> <BR> 'Create a new spatial filter and use the new envelope as the geometry<BR> Set pSpatialFilter = New SpatialFilter<BR> Set pSpatialFilter.Geometry = pEnvelope<BR> pSpatialFilter.SpatialRel = esriSpatialRelIntersects<BR> </P> <P> Dim i As Integer<BR> For i = 0 To pMap.LayerCount - 1<BR> If pMap.Layer(i).Name = "乡镇区划图" Then<BR> Set pFeatureLayer = pMap.Layer(i)<BR> Exit For<BR> End If<BR> Next i<BR> <BR> 'Only search the selectable layers<BR> If pFeatureLayer.Selectable Then<BR>' ShapeFieldName = pFeatureLayer.FeatureClass.ShapeFieldName<BR>' Set pSpatialFilter.OutputSpatialReference(ShapeFieldName) = pMap.SpatialReference<BR> pSpatialFilter.GeometryField = "Shape"</P> <P> Set pFeatureClass = pFeatureLayer.FeatureClass<BR> Set pFeatureCursor = pFeatureClass.Search(pSpatialFilter, False) 'Do the search<BR> Set pFeature = pFeatureCursor.NextFeature 'Get the first feature<BR> If Not pFeature Is Nothing Then<BR> Set FindFeature = pFeature 'Exit if feature is valid<BR> 'Exit Do<BR> End If<BR> End If<BR> </P> <P>Error_h:<BR>End Function<BR></P> <P><FONT color=#ff0033>下面是bas1.bas模块里的定义：</FONT></P> <P>Public TownName As String<BR>Public MapName As String<BR></P> <P><FONT color=#ff0033>下面是shotcutadd类模块的代码：</FONT></P> <P>Private m_pHookHelper As IHookHelper ''for getting Focusmap,ActiveView</P> <P>Implements esriSystemUI.ICommand</P> <P>Private Sub Class_Initialize()</P> <P>Set m_pHookHelper = New HookHelper</P> <P>End Sub</P> <P>Private Sub Class_Terminate()</P> <P> Set m_pHookHelper = Nothing</P> <P>End Sub</P> <P>Private Property Get ICommand_Enabled() As Boolean<BR> <BR> ' TOD Add your implementation here<BR> ICommand_Enabled = True<BR> <BR>End Property</P> <P>Private Property Get ICommand_Checked() As Boolean<BR> <BR> ' TOD Add your implementation here<BR> ' ICommand_Checked =<BR> <BR>End Property</P> <P>Private Property Get ICommand_Name() As String<BR> <BR> ' TOD Add your implementation here<BR> ICommand_Name = "ShotcutAdd"<BR> <BR>End Property</P> <P>Private Property Get ICommand_Caption() As String<BR> <BR> ' TOD Add your implementation here<BR> ICommand_Caption = TownName + MapName<BR> <BR>End Property</P> <P>Private Property Get ICommand_Tooltip() As String<BR> <BR> ' TOD Add your implementation here<BR> ' ICommand_Tooltip =<BR> <BR>End Property</P> <P>Private Property Get ICommand_Message() As String<BR> <BR> ' TOD Add your implementation here<BR> ' ICommand_Message =<BR> <BR>End Property</P> <P>Private Property Get ICommand_HelpFile() As String<BR> <BR> ' TOD Add your implementation here<BR> ' ICommand_HelpFile =<BR> <BR>End Property</P> <P>Private Property Get ICommand_HelpContextID() As Long<BR> <BR> ' TOD Add your implementation here<BR> ' ICommand_HelpContextID =<BR> <BR>End Property</P> <P>Private Property Get ICommand_Bitmap() As esriSystem.OLE_HANDLE<BR> <BR> ' TOD Add your implementation here<BR> ' ICommand_Bitmap =<BR> <BR>End Property</P> <P>Private Property Get ICommand_Category() As String<BR> <BR> ' TOD Add your implementation here<BR> ' ICommand_Category =<BR> <BR>End Property</P> <P>Private Sub ICommand_OnCreate(ByVal hook As Object)<BR> <BR> ' TOD Add your implementation here<BR> Set m_pHookHelper.hook = hook</P> <P> <BR>End Sub</P> <P>Private Sub ICommand_OnClick()</P> <P> Const allpath As String = "E:\江津\行政区划图\"<BR> Dim pWorkspaceFactory As IWorkspaceFactory<BR> Dim pFeatureWorkSpace As IFeatureWorkspace<BR> Dim pFeatureLayer As IFeatureLayer<BR> Dim pMap As IMap<BR> Dim path1 As String<BR> Dim filename As String<BR> 'Dim tfile As String</P> <P> 'Create a new ShapefileWorkspaceFactory object and open a shapefile folder<BR> Set pWorkspaceFactory = New ShapefileWorkspaceFactory<BR> path1 = allpath ; TownName<BR> Set pFeatureWorkSpace = pWorkspaceFactory.OpenFromFile(path1, 0)</P> <P> 'Create a new FeatureLayer and assign a shapefile to it<BR> Set pFeatureLayer = New FEATURELAYER<BR> filename = TownName ; MapName<BR> Set pFeatureLayer.FeatureClass = pFeatureWorkSpace.OpenFeatureClass(filename)<BR> pFeatureLayer.Name = pFeatureLayer.FeatureClass.AliasName</P> <P> 'Add the FeatureLayer to the focus map<BR> Form1.MapControl1.AddLayer pFeatureLayer<BR> <BR>End Sub<BR></P><img src="images/post/smile/dvbbs/em12.gif" /><img src="images/post/smile/dvbbs/em12.gif" /><img src="images/post/smile/dvbbs/em12.gif" /> |
|
|
|
2楼#
发布于：2005-09-10 14:58
<P>改来改去还是一堆的错误，现在我把类模块改成shotcutadd嘛，然后用Dim QuickAdd As ICommand，结果还是提示一堆的错误，说</P>
<P>QuickAdd.TownName = strTownName </P> <P>QuickAdd.MapName = "地形图" 找不到方法和数据成员</P> <img src="images/post/smile/dvbbs/em12.gif" /> [此贴子已经被作者于2005-9-10 15:04:25编辑过]
|
|
|
|
3楼#
发布于：2005-09-10 12:46
<P>程序报什么错呢？</P>
<P> 下面两句也不对，怎么能用Set呢？ 去掉Set</P> <P>Set ShotcutAdd.TownName = strTownName</P> <P> Set ShotcutAdd.MapName = "地形图"</P> |
|
|
|
4楼#
发布于：2005-09-10 09:46
我把shoutcutadd 改成quickadd还是不行
|
|
|
|
5楼#
发布于：2005-09-09 23:17
这样啊，谢谢！谢谢！我想请教一下，我的思路有没有问题，还有没有什么大的问题，麻烦了！
|
|
|
|
6楼#
发布于：2005-09-09 22:31
<P>哪里出错呢？</P>
<P>不过Set ShotcutAdd = New ShotcutAdd这样不好吧，</P> <P>变量名最好不要跟类模块名一样。</P> |
|
|
|
7楼#
发布于：2005-09-09 21:02
<P><FONT color=#ff0066>谢谢斑竹，谢谢，今天照你的思路改过了，调试了一下午，到现在还没有出来，你看看我写的对不对？</FONT></P>
<P>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)<BR> '右键弹出菜单<BR> Dim m_pMapControl As IMapControl3<BR> Dim pActiveView As IActiveView<BR> Dim pPoint As IPoint<BR> Dim pFeature As IFeature<BR> Dim pLayer As ILayer<BR> Dim ShotcutAdd As ICommand<BR> <BR> If Button = vbRightButton Then<BR> <BR> Set pActiveView = MapControl1.ActiveView.FocusMap<BR> <BR> Set pPoint = pActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(x, y)<BR> <BR> Set pFeature = FindFeature(pMxDoc.SearchTolerance, pPoint, MapControl1.ActiveView.FocusMap) ' 调用findfeature过程</P> <P> Set pLayer = m_pMapControl.CustomProperty<BR> <BR> Set strTownName = pFeature.Value(2)<BR> <BR> Set ShotcutAdd = New ShotcutAdd</P> <P> Set ShotcutAdd.TownName = strTownName</P> <P> Set ShotcutAdd.MapName = "地形图"<BR> <BR> m_pToolbarMenu.AddItem ShotcutAdd, , , , esriCommandStyleTextOnly<BR> <BR> m_pToolbarMenu.PopupMenu x, y, MapControl1.hwnd<BR> <BR> End If<BR> <BR>End Sub</P> <P><FONT color=#ff0033>下面是FindFeature过程</FONT></P> <P>Public Function FindFeature(SearchTol As Double, pPoint As IPoint, pMap As IMap) As IFeature<BR> On Error GoTo Error_h:<BR> Dim pEnvelope As IEnvelope<BR> Dim pSpatialFilter As ISpatialFilter<BR> Dim pEnumLayer As IEnumLayer<BR> Dim pFeatureLayer As IFeatureLayer<BR> Dim pFeatureClass As IFeatureClass<BR> Dim pFeatureCursor As IFeatureCursor<BR> Dim pFeature As IFeature<BR> Dim pUID As New UID<BR> Dim ShapeFieldName As String<BR> Dim m_pMapControl As IMapControl3<BR> Dim pLayer As ILayer<BR> <BR> <BR> If pMap.LayerCount = 0 Then Exit Function<BR> <BR> 'Expand the points envelope to give better search results<BR> Set pEnvelope = pPoint.Envelope<BR> pEnvelope.Expand SearchTol, SearchTol, False<BR> <BR> 'Create a new spatial filter and use the new envelope as the geometry<BR> Set pSpatialFilter = New SpatialFilter<BR> Set pSpatialFilter.Geometry = pEnvelope<BR> pSpatialFilter.SpatialRel = esriSpatialRelIntersects<BR> Set pLayer = m_pMapControl.CustomProperty<BR> <BR> Dim i As Integer<BR> For i = 0 To pMap.LayerCount - 1<BR> If pMap.Layer(i).Name = pLayer.Name Then<BR> Set pFeatureLayer = pMap.Layer(i)<BR> Exit For<BR> End If<BR> Next i<BR> <BR> 'Only search the selectable layers<BR> If pFeatureLayer.Selectable Then<BR> ShapeFieldName = pFeatureLayer.FeatureClass.ShapeFieldName<BR> Set pSpatialFilter.OutputSpatialReference(ShapeFieldName) = pMap.SpatialReference<BR> pSpatialFilter.GeometryField = pFeatureLayer.FeatureClass.ShapeFieldName<BR> Set pFeatureClass = pFeatureLayer.FeatureClass<BR> Set pFeatureCursor = pFeatureClass.Search(pSpatialFilter, False) 'Do the search<BR> Set pFeature = pFeatureCursor.NextFeature 'Get the first feature<BR> If Not pFeature Is Nothing Then<BR> Set FindFeature = pFeature 'Exit if feature is valid<BR> 'Exit Do<BR> End If<BR> End If<BR> </P> <P>Error_h:<BR>End Function</P> <P><FONT color=#ff0033>你说的我添加到类模块去了，名字叫shotcutadd</FONT></P> <P> Private Sub ICommand_OnClick()</P> <P> Const allpath As String = "E:\江津\行政区划图\"<BR> Dim pWorkspaceFactory As IWorkspaceFactory<BR> Dim pFeatureWorkspace As IFeatureWorkspace<BR> Dim pFeatureLayer As IFeatureLayer<BR> Dim pMap As IMap<BR> Dim path1 As String<BR> Dim filename As String<BR> Dim tfile As String</P> <P> 'Create a new ShapefileWorkspaceFactory object and open a shapefile folder<BR> Set pWorkspaceFactory = New ShapefileWorkspaceFactory<BR> path1 = allpath ; tfile<BR> Set pFeatureWorkspace = pWorkspaceFactory.OpenFromFile(path1, 0)</P> <P> 'Create a new FeatureLayer and assign a shapefile to it<BR> Set pFeatureLayer = New FEATURELAYER<BR> filename = tfile ; m_MapName<BR> Set pFeatureLayer.FeatureClass = pFeatureWorkspace.OpenFeatureClass(filename)<BR> pFeatureLayer.Name = pFeatureLayer.FeatureClass.AliasName</P> <P> 'Add the FeatureLayer to the focus map<BR> MapControl1.AddLayer pFeatureLayer<BR> <BR>End Sub</P> |
|
|
|
8楼#
发布于：2005-09-09 11:28
<P>当然不用那样吧。我不知道具体情况怎样，但是程序的框架应该：</P>
<P>1、一个Command类模块（假设叫MyCommand）</P> <P>Implements esriSystemUI.ICommand</P> <P>Private m_pHookHelper As IHookHelper ''for getting Focusmap,ActiveView<BR>Private m_TownName as string '乡镇名<BR>Private m_MapName as string '**图名 </P> <P>Private Sub Class_Initialize()</P> <P>Set m_pHookHelper = New HookHelper</P> <P>End Sub</P> <P>Private Sub Class_Terminate()</P> <P> Set m_pHookHelper = Nothing</P> <P>End Sub</P> <P><BR>Public Property Get TownName() As String<BR> TownName =m_TownName<BR>End Property</P> <P>Public Property Let TownName(ByVal NewValue As String)<BR> <BR> m_TownName = NewValue<BR>End Property</P> <P>Public Property Get MapName() As String<BR> MapName =m_MapName<BR>End Property</P> <P>Public Property Let MapName(ByVal NewValue As String)<BR> <BR> m_MapName = NewValue<BR>End Property</P> <P><BR>Private Property Get ICommand_Enabled() As Boolean<BR> <BR> ' TOD Add your implementation here<BR> ICommand_Enabled =True<BR> <BR>End Property<BR> <BR>Private Property Get ICommand_Checked() As Boolean<BR> <BR> ' TOD Add your implementation here<BR> ' ICommand_Checked =<BR> <BR>End Property<BR> <BR>Private Property Get ICommand_Name() As String<BR> <BR> ' TOD Add your implementation here<BR> ICommand_Name = "MyCommand"<BR> <BR>End Property<BR> <BR>Private Property Get ICommand_Caption() As String<BR> <BR> ' TOD Add your implementation here<BR> ICommand_Caption = m_Town+m_MapType<BR> <BR>End Property<BR> <BR>Private Property Get ICommand_Tooltip() As String<BR> <BR> ' TOD Add your implementation here<BR> ' ICommand_Tooltip =<BR> <BR>End Property<BR> <BR>Private Property Get ICommand_Message() As String<BR> <BR> ' TOD Add your implementation here<BR> ' ICommand_Message =<BR> <BR>End Property<BR> <BR>Private Property Get ICommand_HelpFile() As String<BR> <BR> ' TOD Add your implementation here<BR> ' ICommand_HelpFile =<BR> <BR>End Property<BR> <BR>Private Property Get ICommand_HelpContextID() As Long<BR> <BR> ' TOD Add your implementation here<BR> ' ICommand_HelpContextID =<BR> <BR>End Property<BR> <BR>Private Property Get ICommand_Bitmap() As esriSystem.OLE_HANDLE<BR> <BR> ' TOD Add your implementation here<BR> ' ICommand_Bitmap =<BR> <BR>End Property<BR> <BR>Private Property Get ICommand_Category() As String<BR> <BR> ' TOD Add your implementation here<BR> ' ICommand_Category =<BR> <BR>End Property<BR> <BR>Private Sub ICommand_OnCreate(ByVal hook As Object)<BR> <BR> ' TOD Add your implementation here<BR> Set m_pHookHelper.hook = hook</P> <P> <BR>End Sub<BR> <BR>Private Sub ICommand_OnClick()<BR> <BR><FONT color=#ee1196> ' TOD Add your implementation here<BR> ' TOD Add your implementation here<BR> ' TOD Add your implementation here<BR> ' TOD Add your implementation here<BR> ' TOD Add your implementation here</FONT></P> <P>End Sub</P> <P>2、动态添加菜单时</P> <P>通过属性获得乡镇名,保存在strTownName变量中</P> <P> Dim MyCommand1 As ICommand<BR> Set MyCommand1 = New MyCommand</P> <P> MyCommand1.TownName=strTownName</P> <P> MyCommand1.MapName="地形图"<BR> m_pToolbarMenu.AddItem MyCommand1, , , , esriCommandStyleTextOnly</P> <P> Set MyCommand1 = New MyCommand</P> <P> MyCommand1.TownName=strTownName</P> <P> MyCommand1.MapName="土壤图"<BR> m_pToolbarMenu.AddItem MyCommand1, , , , esriCommandStyleTextOnly</P> <P>.....</P> <P>.....</P> <P>不知道是否可行，注意在ICommand_OnClick事件中添加你自己的代码<BR></P> <P> <BR></P> |
|
|
|
9楼#
发布于：2005-09-09 09:29
<P>楼上的斑竹大哥，能不能具体做一个例子出来，实在不好意思，我还是不大明白，谢谢，谢谢了<img src="images/post/smile/dvbbs/em12.gif" /><img src="images/post/smile/dvbbs/em12.gif" /></P>
<P>还有就是m_pToolbarMenu.AddItem后面要做出来接近10个可选择性的添加shp的菜单，是把这个命令做到类模块里吗？但是，那样的话不是要做接近30个乡镇不同的类模块？</P> [此贴子已经被作者于2005-9-9 9:50:54编辑过]
|
|
|
上一页
下一页
