请高手帮忙看看这段代码（vb+ao）

楼主^#

更多发布于：2005-07-07 10:51

我要做元素的选择,以下代码在8.3中用语句5是正确的，用4没有选中元素，
而在9.0中用语句5会出现自动化错误，用4还是没有选中元素，
请大侠们指点一二
Dim pEnumElement As IEnumElement Dim pGraphicsContainer As IGraphicsContainer Set pGraphicsContainer = MapControl1.Map Set pEnumElement = pGraphicsContainer.LocateElementsByEnvelope(pEnvelope) '4 Set pEnumElement = pGraphicsContainer.LocateElements(pPoint,5) '5 If pEnumElement Is Nothing Then Exit Sub

喜欢0 评分0

举报回复

cftao2008 路人甲注册日期2005-03-09 发帖数141 QQ 铜币568枚威望0点贡献值0点银元0个加关注写私信	1楼^# 发布于：2005-07-07 11:03 这段代码在逻辑上没什么错误,你再好好看看上下文,也许是一个非常小的错误,如某个变量少了一个字母!
	举报回复(0) 喜欢(0) 评分

jane2004 路人甲注册日期2005-05-27 发帖数12 QQ 铜币151枚威望0点贡献值0点银元0个加关注写私信	2楼^# 发布于：2005-07-07 16:09 <P>我想应该不是有错，因为在8.3下是可以的</P> <P>有没有哪位大侠在engine中做过元素选择功能，还有其他办法吗？</P>
	举报回复(0) 喜欢(0) 评分

jane2004 路人甲注册日期2005-05-27 发帖数12 QQ 铜币151枚威望0点贡献值0点银元0个加关注写私信	3楼^# 发布于：2005-07-07 17:50 <img src="images/post/smile/dvbbs/em08.gif" />已经解决了，代码没错，只是pPoint忘了赋值
	举报回复(0) 喜欢(0) 评分

syx

路人甲

注册日期2005-11-21
发帖数3
QQ
铜币111枚
威望0点
贡献值0点
银元0个

加关注写私信

4楼^#

发布于：2005-11-21 11:40

Option Explicit
 
'Implements ICommand
Dim ss As String
Dim pSelected As IEnumFeature
Dim pFeature As IFeature
Private m_pApp As IApplication
Private m_pFeedbackEnv As INewEnvelopeFeedback
Private m_pPoint As IPoint
Private m_bIsMouseDown As Boolean
Private m_pFLayer As IFeatureLayer ' layer to search
 
 
Private Sub Form_Resize()
 MapControl1.Top = Me.ScaleTop
 MapControl1.Height = Me.ScaleHeight
 MapControl1.Width = Me.ScaleWidth
 
End Sub
 
Private Sub MapControl1_OnMouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long, ByVal mapX As Double, ByVal mapY As Double)
 Dim pMxDoc As IMxDocument
 Dim pActiveView As IActiveView
 'Set pMxDoc = m_pApp.Document
 Set pActiveView = MapControl1.ActiveView
 
 'Store current point, set mousedown flag
 Set m_pPoint = pActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(x, y)
 ' MsgBox m_pPoint.ID
 m_bIsMouseDown = True
 Set m_pFeedbackEnv = Nothing
 'MsgBox m_pPoint.x
End Sub
 
Private Sub MapControl1_OnMouseMove(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long, ByVal mapX As Double, ByVal mapY As Double)
 On Error GoTo ErrorHandler
 
 If Not m_bIsMouseDown Then Exit Sub
 
 ' Get the ActiveView for the map
 Dim pMxDoc As IMxDocument
 Dim pActiveView As IActiveView
 ' Set pMxDoc = m_pApp.Document
 Set pActiveView = MapControl1.ActiveView
 
 ' Create a rubber banding box, if it hasn't been created already
 If (m_pFeedbackEnv Is Nothing) Then
 Set m_pFeedbackEnv = New NewEnvelopeFeedback
 Set m_pFeedbackEnv.Display = pActiveView.ScreenDisplay
 
 m_pFeedbackEnv.Start m_pPoint
 ' MsgBox m_pPoint.x
 End If
 
 'Store current point, and use to move rubberband
 Set m_pPoint = pActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(x, y)
 m_pFeedbackEnv.MoveTo m_pPoint
 
 Exit Sub
ErrorHandler:
 MsgBox "An error has occured within the Zoom Out Tool." ; vbCr ; vbCr ; _
 "Error Details : " ; Err.Description, vbExclamation + vbOKOnly, "Error"
End Sub
 
Private Sub MapControl1_OnMouseUp(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long, ByVal mapX As Double, ByVal mapY As Double)
 Dim pEnv As IEnvelope
 Dim pFilter As ISpatialFilter
 Dim pActiveView As IActiveView
 Dim pMxDoc As IMxDocument
 Dim pFeat As IFeature
 On Error GoTo ErrorHandler
 
 ' Get the ActiveView for the map
 'Set pMxDoc = m_pApp.Document
 Set pActiveView = MapControl1.ActiveView
'''''''''''''''''''''''''''''''''''
'Set pFilter = New SpatialFilter
 
 ' Set pFilter.Geometry = pActiveView.Extent
 'pFilter.SpatialRel=esri
 '''''''''''''''''''''''''''''''''''''''''''''''''
 ' Refresh the selections
 ' pActiveView.PartialRefresh esriViewGeoSelection, Nothing, Nothing
 pActiveView.PartialRefresh esriViewGeoSelection, Nothing, Nothing
 
 ' If user dragged an envelope...
 If (Not m_pFeedbackEnv Is Nothing) Then
 'Use it to calculate new extent
 
 Set pEnv = m_pFeedbackEnv.Stop
 ' Select all feature that intersect with that shape
 MapControl1.Map.SelectByShape pEnv, Nothing, False
 
 'pMxDoc.FocusMap.SelectByShape pEnv, Nothing, False
 ' Else...
 Else
 ' Select by point
 'pMxDoc.FocusMap.SelectByShape m_pPoint, Nothing, False
 MapControl1.Map.SelectByShape m_pPoint, Nothing, False
 End If
 
 If (MapControl1.Map.SelectionCount <> 1) Then Exit Sub
 If MapControl1.Map.SelectionCount = 1 Then
 MsgBox "已经选中一个要素"
 End If
 Set pSelected = MapControl1.Map.FeatureSelection
 pSelected.Reset
 ' Refresh the selecti
 Set pFeature = pSelected.Next
 If (Not pFeature Is Nothing) Then
 
 MsgBox pFeature.Value(pFeature.Fields.FindField("编号"))
 Set pFeature = pSelected.Next
 End If
 pActiveView.PartialRefresh esriViewGeoSelection, Nothing, Nothing
 
 'Reset rubberband and mousedown state
 Set m_pFeedbackEnv = Nothing
 m_bIsMouseDown = False
 
 'Exit Sub
 
ErrorHandler:
 MsgBox "An error has occured within the Select Tool." ; vbCr ; vbCr ; _
 "Error Details : " ; Err.Description, vbExclamation + vbOKOnly, "Error"
 
 
End Sub
 请那位高手看看我这段代码怎么有什么错误。
pFeature.Value(pFeature.Fields.FindField("编号")) 为空值。
请问高手，怎么选中一个要素，并得到该要素某个字段值

举报回复喜欢评分

wavvylia 路人甲注册日期2003-07-28 发帖数384 QQ 铜币555枚威望0点贡献值0点银元0个加关注写私信	5楼^# 发布于：2005-11-25 14:32 你把<FONT face="Times New Roman">MapControl1.Map.SelectByShape m_pPoint, Nothing, False中的m_pPoint的类型转换为IGeometry再试试看！</FONT>
	举报回复(0) 喜欢(0) 评分

您需要登录后才可以回帖，登录或者注册

请高手帮忙看看这段代码（vb+ao）

最新喜欢：