arcmap选择工具

Imports System.Runtime.InteropServicesImports System.DrawingImports ESRI.ArcGIS.ADF.BaseClassesImports ESRI.ArcGIS.ADF.CATIDsImports ESRI.ArcGIS.FrameworkImports ESRI.ArcGIS.ArcMapUIImports System.Windows.FormsImports ESRI.ArcGIS.GeometryImports ESRI.ArcGIS.Display<ComClass(ABieSelect.ClassId, ABieSelect.InterfaceId, ABieSelect.EventsId), _ProgId("ArcMapClassLibrary1.ABieSelect")> _Public NotInheritable Class ABieSelectInherits BaseTool#Region "COM GUIDs"' These GUIDs provide the COM identity for this class' and its COM interfaces. If you change them, existing' clients will no longer be able to access the class.Public Const ClassId As String = "8e7a8a64-8183-45d3-9421-f8849fa1b57d"Public Const InterfaceId As String = "cb5f867f-25dc-4958-84ac-a756f6942347"Public Const EventsId As String = "aa555bef-dc68-4255-8948-511d4513c3bd"#End Region#Region "COM Registration Function(s)"<ComRegisterFunction(), ComVisibleAttribute(False)> _Public Shared Sub RegisterFunction(ByVal registerType As Type)' Required for ArcGIS Component Category Registrar supportArcGISCategoryRegistration(registerType)'Add any COM registration code after the ArcGISCategoryRegistration() call End Sub#Region "ArcGIS Component Category Registrar generated code"Private Shared Sub ArcGISCategoryRegistration(ByVal registerType As Type)Dim regKey As String = String.Format("HKEY_CLASSES_ROOT\CLSID\{{{0}}}", registerType.GUID)MxCommands.Register(regKey)End SubPrivate Shared Sub ArcGISCategoryUnregistration(ByVal registerType As Type)Dim regKey As String = String.Format("HKEY_CLASSES_ROOT\CLSID\{{{0}}}", registerType.GUID)MxCommands.Unregister(regKey)End Sub#End Region#End RegionPrivate m_application As IApplicationPrivate sFeature As IFeature = NothingDim sf As New abie_selectDim PublicSelect As New List(Of Feature)' A creatable COM class must have a Public Sub New()' with no parameters, otherwise, the class will not be' registered in the COM registry and cannot be created' via CreateObject.Public Sub New()MyBase.New()' TODO: Define values for the public properties' TODO: Define values for the public propertiesMyBase.m_category = "" 'localizable textMyBase.m_caption = "阿别智能选择器" 'localizable textMyBase.m_message = "阿别智能选择器" 'localizable textMyBase.m_toolTip = "阿别智能选择器" 'localizable textMyBase.m_name = "abie_select" 'unique id, non-localizable (e.g. "MyCategory_ArcMapTool")Try'TODO: change resource name if necessaryDim bitmapResourceName As String = Me.GetType().Name + ".bmp"MyBase.m_bitmap = New Bitmap(Me.GetType(), bitmapResourceName)MyBase.m_cursor = New System.Windows.Forms.Cursor(Me.GetType(), Me.GetType().Name + ".cur")Catch ex As ExceptionSystem.Diagnostics.Trace.WriteLine(ex.Message, "Invalid Bitmap")End TryEnd SubPublic Overrides Sub OnCreate(ByVal hook As Object)If Not hook Is Nothing Thenm_application = CType(hook, IApplication)'Disable if it is not ArcMapIf TypeOf hook Is IMxApplication ThenMyBase.m_enabled = TrueElseMyBase.m_enabled = FalseEnd IfEnd If' TODO: Add other initialization codeEnd SubPublic Overrides Sub OnClick()TryDim pMxDocument As IMxDocument = m_application.DocumentDim pMap As IMap = pMxDocument.FocusMapDim pActiveView As IActiveView = pMapDim pEnumFeature As IEnumFeature = pMap.FeatureSelectionDim pFeature As IFeature = pEnumFeature.NextDim pFeatureClass As IFeatureClass = pFeature.ClassDim pQueryFilter As IQueryFilter = New QueryFilterpQueryFilter.WhereClause = pFeatureClass.OIDFieldName & "=" & pFeature.OIDDim pFeatureCursor As IFeatureCursor = pFeatureClass.Update(pQueryFilter, False)pFeature = pFeatureCursor.NextFeatureIf (Not pFeature Is Nothing) ThenDim Data As New List(Of Object)For i As Short = 0 To pFeature.Fields.FieldCount - 1Data.Add(New Object() {pFeature.Fields.Field(i).AliasName, pFeature.Value(i)})NextTrysf.Close()Catch ex As ExceptionEnd Trysf = New abie_selectyer = pFeature.Class.AliasNamesf.Data = Datasf.Doucument = pMxDocumentsf.Show()End IfWhile Not pFeature Is NothingPublicSelect.Add(pFeature)pFeature = pEnumFeature.NextEnd WhileCatch ex As ExceptionMsgBox(ex.Message)End TryEnd Sub'Dim mdx, mdy As New IntegerPublic Overrides Sub OnMouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Integer, ByVal Y As Integer)'TODO: Add ABieSelect.OnMouseDown implementation'mdx = X'mdy = YTryIf Button = 1 ThenDim pMxDocument As IMxDocument = m_application.DocumentDim pMap As IMap = pMxDocument.FocusMapDim pActiveView As IActiveView = pMapDim pRubberBand As IRubberBand = New RubberEnvelopeDim pEnv As IEnvelope = pRubberBand.TrackNew(pMxDocument.ActiveView.ScreenDisplay, Nothing)pMap.ClipGeometry = pEnvDim pFilter As ISpatialFilter = New SpatialFilterWith pFilter '定义选择集过滤.Geometry = pEnv.GeometryField = "SHAPE".WhereClause = sf.Where.SpatialRel = esriSpatialRelEnum.esriSpatialRelIntersectsEnd WithDim pFeatureLayer As IFeatureLayer = GetLayer(pMap, yer)pFeatureLayer.Selectable = TrueDim pfs As IFeatureSelection = pFeatureLayerpfs.SelectFeatures(pFilter, esriSelectionResultEnum.esriSelectionResultNew, False)If Shift Then '按下Shift取消选择Dim pEnumFeature As IEnumFeature = pMap.FeatureSelectionDim pFeature As IFeature = pEnumFeature.NextWhile Not pFeature Is NothingPublicSelect.Remove(pFeature)pFeature = pEnumFeature.NextEnd Whilepfs.Clear()For Each ipFeature In PublicSelectpfs.Add(ipFeature)NextElse '正常选择直接加入选择集For Each ipFeature In PublicSelectpfs.Add(ipFeature)NextDim pEnumFeature As IEnumFeature = pMap.FeatureSelectionDim pFeature As IFeature = pEnumFeature.NextPublicSelect.Clear()While Not pFeature Is NothingPublicSelect.Add(pFeature)pFeature = pEnumFeature.NextEnd WhileEnd IfpActiveView.PartialRefresh(esriViewDrawPhase.esriViewGeoSelection, Nothing, Nothing)pActiveView.Refresh()pMxDocument.ActiveView.Refresh()ElseIf Button = 2 ThenTryTrysf.Close()Catch ex As ExceptionEnd TryDim pMxDocument As IMxDocument = m_application.DocumentDim pMap As IMap = pMxDocument.FocusMapDim pActiveView As IActiveView = pMapDim pRubberBand As IRubberBand = New RubberEnvelopeDim pEnv As IEnvelope = pRubberBand.TrackNew(pMxDocument.ActiveView.ScreenDisplay, Nothing)pMap.ClipGeometry = pEnvDim pFilter As ISpatialFilter = New SpatialFilterWith pFilter '定义选择集过滤.Geometry = pEnv.GeometryField = "SHAPE".SpatialRel = esriSpatialRelEnum.esriSpatialRelIntersectsEnd WithDim pFeatureLayer As IFeatureLayer = GetLayer(pMap, yer)pFeatureLayer.Selectable = TrueDim pfs As IFeatureSelection = pFeatureLayerpfs.SelectFeatures(pFilter,esriSelectionResultEnum.esriSelectionResultNew, False)Dim pEnumFeature As IEnumFeature = pMap.FeatureSelectionDim pFeature As IFeature = pEnumFeature.NextDim pFeatureClass As IFeatureClass = pFeature.ClassDim pQueryFilter As IQueryFilter = New QueryFilterpQueryFilter.WhereClause = pFeatureClass.OIDFieldName & "=" & pFeature.OIDDim pFeatureCursor As IFeatureCursor = pFeatureClass.Update(pQueryFilter, False)pFeature = pFeatureCursor.NextFeatureIf (Not pFeature Is Nothing) ThenDim Data As New List(Of Object)For i As Short = 0 To pFeature.Fields.FieldCount - 1Data.Add(New Object() {pFeature.Fields.Field(i).AliasName, pFeature.Value(i)})Nextsf = New abie_selectyer = pFeature.Class.AliasNamesf.Data = Datasf.Doucument = pMxDocumentsf.Show()End IfFor Each ipFeature In PublicSelectpfs.Add(ipFeature)NextWhile Not pFeature Is NothingPublicSelect.Add(pFeature)pFeature = pEnumFeature.NextEnd WhilepActiveView.PartialRefresh(esriViewDrawPhase.esriViewGeoSelection, Nothing, Nothing)pActiveView.Refresh()pMxDocument.ActiveView.Refresh()Catch ex As ExceptionMsgBox(ex.Message)End TryEnd IfCatch ex As ExceptionMsgBox(ex.Message)End TryEnd SubEnd Class。