<img src="images/post/smile/dvbbs/em01.gif" /><img src="images/post/smile/dvbbs/em01.gif" /><img src="images/post/smile/dvbbs/em01.gif" /><img src="images/post/smile/dvbbs/em01.gif" /><img src="images/post/smile/dvbbs/em02.gif" /><img src="images/post/smile/dvbbs/em02.gif" />

<img src="images/post/smile/dvbbs/em04.gif" />thx点津

<img src="images/post/smile/dvbbs/em01.gif" /><img src="images/post/smile/dvbbs/em01.gif" />

<img src="images/post/smile/dvbbs/em03.gif" />

<P><FONT color=#4d2bd5>我最近刚接触这个。有点疑问：vba+ao 开发模式，个人觉得 。没有实际的项目意义。（从运行环境，要调用arcmap ，arccatloge 等；加上数据库操作以后，界面和功能上都有不方便的地方。）所以 ，vba作用 可以实现一些，文件转换的批处理等等。不必深入。vb +ao 运用更广泛些。所以， 我很赞成第一页的那位发起者，算我一个，大家研究研究。。。</FONT></P>

<P>addshapefiles修正版，可直接拷贝使用</P><P 0cm 0cm 0pt"><FONT face="Times New Roman">Public Sub AddShapeFile()</FONT></P><P 0cm 0cm 0pt"><FONT face="Times New Roman">  Dim pWorkspaceFactory As IWorkspaceFactory</FONT></P><P 0cm 0cm 0pt"><FONT face="Times New Roman">  Dim pFeatureWorkspace As IFeatureWorkspace</FONT></P><P 0cm 0cm 0pt"><FONT face="Times New Roman">  Dim pFeatureLayer As IFeatureLayer</FONT></P><P 0cm 0cm 0pt"><FONT face="Times New Roman">  Dim pMxDocument As IMxDocument</FONT></P><P 0cm 0cm 0pt"><FONT face="Times New Roman">  Dim pMap As IMap</FONT></P><P 0cm 0cm 0pt"><FONT face="Times New Roman">  </FONT></P><P 0cm 0cm 0pt"><FONT face="Times New Roman">  Dim pFeatureDataset As IGxDataset</FONT></P><P 0cm 0cm 0pt"><FONT face="Times New Roman">  Dim pGxDialog As IGxDialog</FONT></P><P 0cm 0cm 0pt"><FONT face="Times New Roman">  Dim pGxCatalog As IGxCatalog</FONT></P><P 0cm 0cm 0pt"><FONT face="Times New Roman">  Set pGxDialog = New GxDialog</FONT></P><P 0cm 0cm 0pt"><FONT face="Times New Roman">  With pGxDialog</FONT></P><P 0cm 0cm 0pt"><FONT face="Times New Roman">    .AllowMultiSelect = False</FONT></P><P 0cm 0cm 0pt"><FONT face="Times New Roman">    Set .ObjectFilter = New GxFilterFeatureClasses</FONT></P><P 0cm 0cm 0pt"><FONT face="Times New Roman">    .DoModalOpen ThisDocument.Parent.hWnd, Nothing</FONT></P><P 0cm 0cm 0pt"><FONT face="Times New Roman">    Set pGxCatalog = .InternalCatalog</FONT></P><P 0cm 0cm 0pt"><FONT face="Times New Roman">    Set pFeatureDataset = pGxCatalog.SelectedObject</FONT></P><P 0cm 0cm 0pt"><FONT face="Times New Roman">  End With</FONT></P><P 0cm 0cm 0pt"><FONT face="Times New Roman">  Dim sWSName As String</FONT></P><P 0cm 0cm 0pt"><FONT face="Times New Roman">  Dim sFeatureName As String</FONT></P><P 0cm 0cm 0pt"><FONT face="Times New Roman">    sFeatureName = pFeatureDataset.Dataset.BrowseName</FONT></P><P 0cm 0cm 0pt"><FONT face="Times New Roman">    sWSName = pFeatureDataset.Dataset.Workspace.PathName</FONT></P><P 0cm 0cm 0pt"><FONT face="Times New Roman">    'MsgBox pFeatureDataset.Dataset.Name</FONT></P><P 0cm 0cm 0pt"><FONT face="Times New Roman">  'Create a new ShapefileWorkspaceFactory object and open a shapefile folder</FONT></P><P 0cm 0cm 0pt"><FONT face="Times New Roman">  Set pWorkspaceFactory = New ShapefileWorkspaceFactory</FONT></P><P 0cm 0cm 0pt"><FONT face="Times New Roman">  </FONT></P><P 0cm 0cm 0pt"><FONT face="Times New Roman">  Set pFeatureWorkspace = pWorkspaceFactory.OpenFromFile(sWSName, 0)</FONT></P><P 0cm 0cm 0pt"><FONT face="Times New Roman">  'Create a new FeatureLayer and assign a shapefile to it</FONT></P><P 0cm 0cm 0pt"><FONT face="Times New Roman"> </FONT></P><P 0cm 0cm 0pt"><FONT face="Times New Roman">  Set pFeatureLayer = New FeatureLayer</FONT></P><P 0cm 0cm 0pt"><FONT face="Times New Roman">  </FONT></P><P 0cm 0cm 0pt"><FONT face="Times New Roman">  Set pFeatureLayer.FeatureClass = pFeatureWorkspace.OpenFeatureClass(sFeatureName)</FONT></P><P 0cm 0cm 0pt"><FONT face="Times New Roman">  pFeatureLayer.Name = pFeatureLayer.FeatureClass.AliasName</FONT></P><P 0cm 0cm 0pt"><FONT face="Times New Roman">  'Add the FeatureLayer to the focus map</FONT></P><P 0cm 0cm 0pt"><FONT face="Times New Roman">  Set pMxDocument = Application.Document</FONT></P><P 0cm 0cm 0pt"><FONT face="Times New Roman">  Set pMap = pMxDocument.FocusMap</FONT></P><P 0cm 0cm 0pt"><FONT face="Times New Roman">  pMap.AddLayer pFeatureLayer</FONT></P><P 0cm 0cm 0pt"><FONT face="Times New Roman">  pMxDocument.ActiveView.Refresh</FONT></P><P 0cm 0cm 0pt"><FONT face="Times New Roman">End Sub</FONT></P>

<P>好啊,期待继续呵呵</P>

<P>偶是新手,刚入门,先贴一个代码,就是ARCGIS中的IDENTIFY功能,偶的功能比ARCGIS稍微改进了一下,就是在鼠标按下时,如果没有地物就不弹出属性窗口,代码中如有不对,请大家指正,呵呵,偶是刚学的,希望大家不要见笑</P><P>Public Sub mapIdentify(m_map As MapControl, x As Long, y As Long) '////属性窗口
  Dim pIdentifyDialog As IIdentifyDialog
  Dim pIdentifyDialogProps As IIdentifyDialogProps
  Dim pEnumLayer As IEnumLayer
  Dim pLayer As ILayer
  
  Dim pPoint As IPoint                                                                        '//
  Dim pLyr As ILayer                                                                          '//
  Dim pIdentify As IIdentify                                                                  '//
  Dim pIDArray As IArray                                                                      '//
  Dim i As Long                                                                               '//
  Dim j As Long                                                                               '//判断鼠标按下的点
  For j = 0 To m_map.LayerCount - 1                                                           '//是否有地物,如有
    Set pIdentify = m_map.Layer(j)                                                            '//弹出属性框,没有
    Set pPoint = m_map.ActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(x, y)        '//则无任何显示,比
    Set pIDArray = pIdentify.Identify(pPoint)                                                 '//ARCGIS的属性功能
    If Not pIDArray Is Nothing Then                                                           '//稍微改进了一下
      i = i + 1                                                                               '//
    End If                                                                                    '//
  Next                                                                                        '//
  If i = 0 Then Exit Sub                                                                      '//
  
  Set pIdentifyDialog = New IdentifyDialog
  Set pIdentifyDialogProps = pIdentifyDialog
  Set pIdentifyDialog.map = m_map.ActiveView.FocusMap
  Set pIdentifyDialog.Display = m_map.ActiveView.ScreenDisplay
  pIdentifyDialog.ClearLayers
  Set pEnumLayer = pIdentifyDialogProps.Layers
  pEnumLayer.Reset
  Set pLayer = pEnumLayer.Next
  Do While (Not pLayer Is Nothing)
    'Set pPoint = m_map.ActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(x, y)
    'pIdentifyDialog.AddLayerIdentifyOID pLayer, pPoint.ID  '////flash the OID object,需进一步研究
    pIdentifyDialog.AddLayerIdentifyPoint pLayer, x, y
    Set pLayer = pEnumLayer.Next
  Loop</P><P>  pIdentifyDialog.Show
End Sub</P>

<P>好长时间没来了,前段时间参加关于那个Arcgis竞赛的编程,具体的程序,以后我会贴出来,这里可以跟大家讨论一下关于在Mapcontrol中添加图例的问题,虽然问题有点老,而且相应的控件已经快出来了,不过我们的目的还是:通过自己动手写,增加自己的"经验值"呵呵</P><P>那么首先可以讨论一下如何实现Renderer为:ClassBreaksRenderer(说明:Renderer为SimpleRenderer的实现过程,已有相关贴子),过几天,我会把我的实现过程发上来.</P>

对阿.这些功能vba里面不是可以通过拖拽相应按钮添加么?为什么还要写代码呢??