<P>支持中、、、、、、</P>

<P>利用ao删除选择的要素</P>
<P>打开Visual Basic Editor，拷贝下面代码</P>  
<P>Option Explicit<BR><BR><BR><BR>Public Sub Main()<BR><BR>  <BR><BR>    Dim pDoc As IMxDocument<BR><BR>    Dim pLayer As IFeatureLayer<BR><BR>    Dim mySet As ISet<BR><BR>    Dim pFeature As IFeature<BR><BR>    Dim pEnumFeature As IEnumFeature<BR><BR>    Dim pEditor As IEditor<BR><BR>    Dim pUID As New UID<BR><BR>    <BR><BR>    Set pDoc = Application.Document<BR><BR>    Set pEnumFeature = pDoc.ActiveView.Selection<BR><BR>    pEnumFeature.Reset<BR><BR>    Set pFeature = pEnumFeature.Next<BR><BR>    pUID = "esricore.editor"<BR><BR>    Set pEditor = Application.FindExtensionByCLSID(pUID)<BR><BR>    <BR><BR>    Set pDoc = Application.Document<BR><BR>    <BR><BR>    'Make certain the layer is selected in the TOC<BR><BR>    Set pLayer = pDoc.SelectedLayer<BR><BR>    <BR><BR>    'Check to make certain that there is an edit session started<BR><BR>    If pEditor.EditState = esriStateNotEditing Then<BR><BR>            MsgBox "Cannot Edit outside of an edit session"<BR><BR>    End If<BR><BR>    'Call the DeleteSelectedFeatures sub procedure<BR><BR>    'and pass in the EnumFeature object.<BR><BR>    <BR><BR>    DeleteSelectedFeatures pEnumFeature<BR><BR>    pDoc.ActiveView.Refresh<BR><BR>   <BR><BR>    <BR><BR><BR><BR>End Sub<BR><BR><BR><BR>Private Sub DeleteSelectedFeatures(pEnumFeature As IEnumFeature)<BR><BR>    <BR><BR>    Dim pFeature As IFeature<BR><BR>    Dim mySet As esriCore.ISet<BR><BR>    Set mySet = New esriCore.Set<BR><BR>    Dim pFeatureEdit As IFeatureEdit<BR><BR><BR><BR>    pEnumFeature.Reset<BR><BR>    Set pFeature = pEnumFeature.Next<BR><BR>  <BR><BR>    'Takes features and writes them out to an ISet object<BR><BR>    Do Until pFeature Is Nothing<BR><BR>        Set pFeatureEdit = pFeature<BR><BR>        mySet.Add pFeature<BR><BR>        Set pFeature = pEnumFeature.Next<BR><BR>    Loop<BR><BR>    <BR><BR>    'Calls the deleteset method from IFeatureEdit<BR><BR>    'to delete the selected set of records<BR><BR>    pFeatureEdit.DeleteSet mySet<BR><BR>    <BR><BR>End Sub<BR></P>
<P>选择要素，运行micro就可以了</P>

<P>如何得到图形的基本属性</P>
<P>本例要实现的功能是得到一个FeatureLayer中被选择的Feature的基本图形属性，如，图形的维数，类型，范围，空间坐标系统等。</P>
<P>l 要点</P>
<P>接口IGeometry的主要属性有Dimension(维数)，GeometryType（图形类型），Envelope（范围），IsEmpty （是否为空），SpatialReference（空间坐标系）等。</P>
<P>l 程序说明</P>
<P>该过程在开始处使用IEnumFeature接口来得到所选择的Features,用Next方法取得每个Feature。然后利用IFeature接口的Shape属性得到Geometry。最后弹出消息框显示图形的属性信息。</P>
<P>l 代码</P>
<P>Public Sub GetGeometryProperty()<BR>    Dim pMxDocument    As IMxDocument<BR>    Dim pEnumFeature   As IEnumFeature<BR>    Dim pFeature       As IFeature<BR>    Dim pGeometry      As IGeometry<BR>    On Error GoTo ErrorHandler<BR>    Set pMxDocument = Application.Document<BR>    '得到图形集<BR>    Set pEnumFeature = pMxDocument.FocusMap.FeatureSelection<BR>    '重新设置图形集<BR>    pEnumFeature.Reset<BR>    '得到第一个图形<BR>    Set pFeature = pEnumFeature.Next<BR>    '判断是否有图形被选上<BR>    If pFeature Is Nothing Then<BR>        MsgBox "no selection,please select a Feature"<BR>    Else<BR>        ‘循环图形，直到最后<BR>        While Not pFeature Is Nothing<BR>        Set pGeometry = pFeature.Shape<BR>        '得到图形的基本属性<BR>        MsgBox "+++Polygon::IGeometry properties..." ; vbCrLf _<BR>        ; "Dimension = " ; pGeometry.Dimension ; vbCrLf _<BR>        ; "Geometry type = " ; pGeometry.GeometryType ; vbCrLf _<BR>        ; "Envelope =  " ; pGeometry.Envelope.XMin ; "," ;pGeometry.Envelope.YMin ; "," _<BR>        ; pGeometry.Envelope.XMax ; "," ; pGeometry.Envelope.YMin ; vbCrLf _<BR>        ; "IsEmpty =  " ; pGeometry.IsEmpty ; vbCrLf _<BR>        ; "SpatialReference = " ; pGeometry.SpatialReference.Name<BR>        ‘指向下一个图形<BR>        Set pFeature = pEnumFeature.Next<BR>        Wend<BR>    End If<BR>    Exit Sub<BR>ErrorHandler:<BR>    MsgBox Err.Description<BR>End Sub</P>

 如何画Polygon Buffers
<P>本例要实现的是如何利用Polygon Buffer自定义记录选中时的显示方式。</P>
<P>l   要点</P>
<P>首先通过IRgbColor接口和ISimpleFillSymbol接口设置Polygon Buffer的填充方式。然后在发生SelectionChanged事件时，设置选中记录被显示时的边界并将选中的Polygon通过ITopologicalOperator.ConstructUnion方法，联合成一个临时的Polygon Buffer，使用IActiveView.PartialRefresh方法刷新这个Polygon Buffer区域，最后在发生AfterItemDraw事件时将这个Polygon Buffer画在Map上。</P>
<P>主要用到IPolygon接口，IEnvelope接口，ISimpleFillSymbol接口，IActiveView接口，IEnumFeature接口，IGeometryCollection接口和ITopologicalOperator接口。</P>
<P>l   程序说明</P>
<P>函数InitEvents是初始化变量并设置Polygon Buffer的填充方式。</P>
<P>AfterItemDraw事件实现的是画出Polygon Buffer。</P>
<P>SelectionChanged事件实现的是生成Polygon Buffer并设置边界。</P>
<P>l   代码</P>
<P>
<P>Private WithEvents ActiveViewEvents     As Map          <BR>Private pMxDocument                     As IMxDocument<BR>Private pBufferPolygon                  As IPolygon<BR>Private pEnvelope                       As IEnvelope<BR>Private pSimpleFillS                    As ISimpleFillSymbol </P>
<P>Public Sub InitEvents()<BR>    Dim pViewManager                    As IViewManager<BR>    Dim pRgbColor                       As IRgbColor<BR>    Set pMxDocument = Application.Document<BR>    Set pViewManager = pMxDocument.FocusMap<BR>    pViewManager.VerboseEvents = True<BR>    Set ActiveViewEvents = pMxDocument.FocusMap<BR>    'Create a fill symbol<BR>    Set pSimpleFillS = New SimpleFillSymbol<BR>    Set pRgbColor = New RgbColor<BR>    pRgbColor.Red = 255<BR>    pSimpleFillS.Style = esriSFSForwardDiagonal<BR>    pSimpleFillS.Color = pRgbColor<BR>End Sub </P>
<P>Private Sub ActiveViewEvents_AfterItemDraw(ByVal Index As Integer, ByVal Display As IDisplay, ByVal phase As esriDrawPhase)<BR>    'Only draw in the geography phase<BR>    If Not phase = esriDPGeography Then Exit Sub<BR>    'Draw the buffered polygon<BR>    If pBufferPolygon Is Nothing Then Exit Sub<BR>    With Display<BR>        .SetSymbol pSimpleFillS<BR>        .DrawPolygon pBufferPolygon<BR>    End With<BR>End Sub </P>
<P>Private Sub ActiveViewEvents_SelectionChanged()<BR>    Dim pActiveView                     As IActiveView<BR>    Dim pEnumFeature                    As IEnumFeature<BR>    Dim pFeature                        As IFeature<BR>    Dim pSelectionPolygon               As IPolygon<BR>    Dim pTopologicalOperator            As ITopologicalOperator<BR>    Dim pGeometryCollection             As IGeometryCollection<BR>      Set pActiveView = pMxDocument.FocusMap<BR>    Set pGeometryCollection = New GeometryBag<BR>    'Flag last buffered region for invalidation<BR>    If Not pEnvelope Is Nothing Then<BR>        pActiveView.PartialRefresh esriViewGeography, Nothing, pEnvelope<BR>    End If<BR>    If pMxDocument.FocusMap.SelectionCount = 0 Then<BR>        'Nothing selected; don't draw anything; bail<BR>        Set pBufferPolygon = Nothing<BR>        Exit Sub<BR>    End If<BR>    'Buffer each selected feature<BR>    Set pEnumFeature = pMxDocument.FocusMap.FeatureSelection<BR>    pEnumFeature.Reset<BR>    Set pFeature = pEnumFeature.Next<BR>    Do While Not pFeature Is Nothing<BR>        Set pTopologicalOperator = pFeature.Shape<BR>        Set pSelectionPolygon = pTopologicalOperator.Buffer(0.1)<BR>        pGeometryCollection.AddGeometry pSelectionPolygon<BR>        'Get next feature<BR>        Set pFeature = pEnumFeature.Next<BR>    Loop<BR>    'Union all the buffers into one polygon<BR>    Set pBufferPolygon = New Polygon<BR>    Set pTopologicalOperator = pBufferPolygon 'QI<BR>    pTopologicalOperator.ConstructUnion pGeometryCollection<BR>    Set pEnvelope = pBufferPolygon.Envelope<BR>    'Flag new buffered region for invalidation<BR>    pActiveView.PartialRefresh esriViewGeography, Nothing, pBufferPolygon.Envelope<BR>End Sub </P>
<P>Private Sub UIButtonControl1_Click()<BR>    InitEvents<BR>End Sub</P>
<br>

如何实现在ArcMap中进行动作的撤销和重做
<P>本例要演示的是如何在ArcMap中对图形的移动动作进行撤销和重做，用到IExtentStack接口。以帮助理解ArcMap中对撤销和重做实现的方法。</P>
<P>l   要点</P>
<P>IActiveView的ExtentStack属性保存了其Extent改变的“历史记录”，而IMxDocument的OperationStack属性则有能力记录更复杂的编辑动作的历史。用户只有深刻理解了概念，才能够完成特定功能“历史记录”的定制。</P>
<P>l   程序说明</P>
<P>过程 Extent_UnDo和Extent_RnDo分别模拟了ArcMap中Tools工具栏上的“Go Back To Previous Extent”和“Go To Next Extent”两个按钮的功能。</P>
<P>l   代码</P>
<P>
<P>Option Explicit </P>
<P>Public Sub Extent_UnDo()<BR>    Dim pMxDocument     As IMxDocument<BR>    Dim pActiveView     As IActiveView<BR>    Dim pExtentStack    As IExtentStack<BR>    On Error GoTo ErrorHandler<BR>    Set pMxDocument = ThisDocument<BR>    Set pActiveView = pMxDocument.FocusMap<BR>    Set pExtentStack = pActiveView.ExtentStack<BR>    If pExtentStack.CanUndo Then<BR>        pExtentStack.Undo<BR>    End If<BR>    Exit Sub<BR>ErrorHandler:<BR>    MsgBox Err.Description<BR>End Sub </P>
<P>Public Sub Extent_ReDo()<BR>    Dim pMxDocument     As IMxDocument<BR>    Dim pActiveView     As IActiveView<BR>    Dim pExtentStack    As IExtentStack<BR>    On Error GoTo ErrorHandler<BR>    Set pMxDocument = ThisDocument<BR>    Set pActiveView = pMxDocument.FocusMap<BR>    Set pExtentStack = pActiveView.ExtentStack<BR>    If pExtentStack.CanRedo Then<BR>        pExtentStack.Redo<BR>    End If<BR>    Exit Sub<BR>ErrorHandler:<BR>    MsgBox Err.Description<BR>End Sub</P>
<br>

<P>如何实现在ArcMap中移动地图</P>
<P>  </P>
<P>用户点击按钮后，可以拖动地图显示</P>
<P>l 要点</P>
<P>采用IActiveView.ScreenDisplay.PanStart和PanStop方法使地图移动。</P>
<P>l 程序说明</P>
<P>通过IActiveView.ScreenDisplay的PanStart和PanStop方法在ITool的MouseDown,MouseUp和MouseMove事件的响应实现移动效果，将移动结果得到IEnvelope赋值给IActiveView.Extent，实现地图的刷新</P>
<P>l 代码</P>
<P>
<P>Option Explicit<BR>Private m_pMxApp            As IMxApplication<BR>Private m_pMxDocument       As IMxDocument<BR>Private m_pScreenDisplay    As IScreenDisplay<BR>Private m_pMapInsetWindow   As IMapInsetWindow<BR>Private m_bMouseDown        As Boolean </P>
<P>Private Sub UIToolControl1_MouseDown(ByVal button As Long, ByVal shift As Long, _ByVal x As Long, ByVal y As Long)<BR>    Dim pStartPoint As IPoint<BR>    If Not button = 1 Then Exit Sub<BR>    Set m_pScreenDisplay = GetFocusDisplay<BR>    Set m_pMapInsetWindow = GetMapInset(m_pScreenDisplay)<BR>    If Not m_pMapInsetWindow Is Nothing Then<BR>        If m_pMapInsetWindow.IsLive Then Exit Sub<BR>    End If<BR>    m_bMouseDown = True<BR>    Set pStartPoint = m_pScreenDisplay.DisplayTransformation.ToMapPoint(x, y)<BR>    '得到起始点，开始移动<BR>    m_pScreenDisplay.PanStart pStartPoint<BR>End Sub </P>
<P>Private Sub UIToolControl1_MouseMove(ByVal button As Long, ByVal shift As Long, _ByVal x As Long, ByVal y As Long)<BR>    Dim pMoveToPoint As IPoint<BR>    If Not m_bMouseDown Then Exit Sub<BR>    Set pMoveToPoint = m_pScreenDisplay.DisplayTransformation.ToMapPoint(x, y)<BR>    '根据鼠标移动，移动地图<BR>    m_pScreenDisplay.PanMoveTo pMoveToPoint<BR>End Sub </P>
<P>Private Sub UIToolControl1_MouseUp(ByVal button As Long, ByVal shift As Long, _ByVal x As Long, ByVal y As Long)<BR>    Dim pEnvelope        As IEnvelope<BR>    Dim pActiveView      As IActiveView<BR>    Dim pMapInset        As IMapInset<BR>    Dim pMapInsetWindow  As IMapInsetWindow  <BR>    If Not m_bMouseDown Then Exit Sub<BR>    m_bMouseDown = False<BR>    Set pEnvelope = m_pScreenDisplay.PanStop<BR>    If pEnvelope Is Nothing Then Exit Sub<BR>    '窗口判断<BR>    If Not m_pMapInsetWindow Is Nothing Then<BR>        Set pMapInset = m_pMapInsetWindow.MapInset<BR>        pMapInset.VisibleBounds = pEnvelope<BR>        m_pMapInsetWindow.Refresh<BR>        Exit Sub<BR>    Else<BR>        Set pActiveView = m_pMxDocument.ActiveView<BR>        '地图刷新<BR>        If TypeOf pActiveView Is IMap Then<BR>            pActiveView.Extent = pEnvelope<BR>            pActiveView.Refresh<BR>        Else<BR>            Set pActiveView = pActiveView.FocusMap<BR>            pActiveView.Extent = pEnvelope<BR>            pActiveView.Refresh<BR>        End If<BR>    End If<BR>End Sub </P>
<P>Private Sub UIToolControl1_Select()<BR>    '初始化接口<BR>    m_bMouseDown = False<BR>    Set m_pMxApp = Application<BR>    Set m_pMxDocument = Application.Document<BR>End Sub </P>
<P>Private Function GetFocusDisplay() As IScreenDisplay<BR>    Dim pActiveView   As IActiveView<BR>    Dim pActiveMap    As IMap<BR>    Set pActiveView = m_pMxDocument.ActiveView<BR>    If TypeOf pActiveView Is IMap Then<BR>        Set GetFocusDisplay = m_pMxApp.Display.FocusScreen<BR>    Else<BR>        Set pActiveView = pActiveView.FocusMap<BR>        Set GetFocusDisplay = pActiveView.ScreenDisplay<BR>    End If<BR>End Function </P>
<P>Private Function GetMapInset(pScreenDisplay As IScreenDisplay) As IMapInsetWindow<BR>    Dim pAppWindows As IApplicationWindows<BR>    Dim pWindowsSet As ISet<BR>    Dim pDataWindow As IDataWindow<BR>    Dim pLensWindow As ILensWindow<BR>    Set pAppWindows = m_pMxApp 'QI<BR>    Set pWindowsSet = pAppWindows.DataWindows<BR>    pWindowsSet.Reset<BR>    Set pDataWindow = pWindowsSet.Next<BR>    Do While Not pDataWindow Is Nothing<BR>        If TypeOf pDataWindow Is ILensWindow Then<BR>            Set pLensWindow = pDataWindow<BR>            If pLensWindow.ScreenDisplay Is m_pScreenDisplay Then<BR>                If TypeOf pLensWindow Is IMapInsetWindow Then<BR>                    Set GetMapInset = pLensWindow<BR>                    Exit Function<BR>                End If<BR>            End If<BR>        End If<BR>        Set pDataWindow = pWindowsSet.Next<BR>    Loop<BR>    Set GetMapInset = Nothing<BR>End Function</P>
<br>

感谢总统！！ 辛苦了！！！！！！

一个建议：猪头外劳能否在代码后面加上实现后的结果截图，让看得人更直观，也有助于对你程序的理解，更好的学习

vb环境下，利用AO组件开发Active.DLL。关键是要引用Arcobjects的对象库和实现arcobjects接口（如Icommand,Itool,Itoolbar等），请问如何实现接口？

 如何实现在ArcMap中放大缩小地图
<P>用户点击按钮后，可以在地图上进行点击或者拖放矩形框来放大缩小地图</P>
<P>l 要点</P>
<P>因为考虑到用户可以单击放大缩小，也可以拖放矩形框来放大缩小，所以不可以直接使用IRubberBand接口，而是采用INewEnvelopeFeedback接口</P>
<P>l 程序说明</P>
<P>主要通过InewEnvelopeFeedback.StartPoint 和MoveTo方法来绘制矩形框，然后赋值给IActiveView.Extend属性，达到地图的放大缩小</P>
<P>l 代码</P>
<P>
<P>Private m_pFeedbackEnv      As INewEnvelopeFeedback<BR>Private m_pPoint            As IPoint<BR>Private m_bIsMouseDown      As Boolean<BR>Private m_pActiveView       As IActiveView </P>
<P>Private Sub UIToolControl1_MouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, _ByVal y As Long)<BR>    Dim pMxDocument As IMxDocument<BR>On Error GoTo ErrorHandler:<BR>    'Left Button Check<BR>    If button <> 1 Then Exit Sub<BR>    If m_pActiveView Is Nothing Then<BR>        Set pMxDocument = ThisDocument<BR>        Set m_pActiveView = pMxDocument.ActivatedView<BR>    End If<BR>    '得到起始点<BR>    Set m_pPoint = m_pActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(x, y)<BR>    m_bIsMouseDown = True<BR>    Exit Sub<BR>ErrorHandler:<BR>    MsgBox Err.Description<BR>End Sub </P>
<P>Private Sub UIToolControl1_MouseMove(ByVal button As Long, ByVal shift As Long, ByVal x As Long, _ByVal y As Long)<BR>On Error GoTo ErrorHandler:<BR>    If Not m_bIsMouseDown Then Exit Sub<BR>    If m_pFeedbackEnv Is Nothing Then<BR>        Set m_pFeedbackEnv = New NewEnvelopeFeedback<BR>        Set m_pFeedbackEnv.Display = m_pActiveView.ScreenDisplay<BR>        m_pFeedbackEnv.Start m_pPoint<BR>    End If<BR>    Set m_pPoint = m_pActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(x, y)<BR>    'Draw Envelope<BR>    m_pFeedbackEnv.MoveTo m_pPoint<BR>    Exit Sub<BR>ErrorHandler:<BR>    MsgBox Err.Description<BR>End Sub</P>
<P>Private Sub UIToolControl1_MouseUp(ByVal button As Long, ByVal shift As Long, ByVal x As Long, _ByVal y As Long)<BR>    Dim pEnv As IEnvelope<BR>On Error GoTo ErrorHandler:<BR>    'Left Button Check<BR>    If button <> 1 Then Exit Sub<BR>    If (m_pFeedbackEnv Is Nothing) Then<BR>        'User Only Click Map with left button<BR>        Set pEnv = m_pActiveView.Extent<BR>        '如果是缩小的话，将这里的两个0.5都改成1.5<BR>        pEnv.Expand 0.5, 0.5, True<BR>    Else<BR>        'User Draw a Envelope<BR>        Set pEnv = m_pFeedbackEnv.Stop<BR>    End If<BR>    m_pActiveView.Extent = pEnv<BR>    m_bIsMouseDown = False<BR>    Set m_pPoint = Nothing<BR>    Set m_pFeedbackEnv = Nothing<BR>    m_pActiveView.Refresh<BR>    Exit Sub<BR>ErrorHandler:<BR>    MsgBox Err.Description<BR>End Sub</P>
<br>