| 作者：天涯地物 提交日期：2006-3-10 19:49:00 | <script src="http://hot.tianyaclub.com/hot.js"></script> |
本例要演示的是如何查询Feature的属性信息。实现后的结果为选择了UI Tool Control后，在要查询的Feature上单击鼠标，查询的结果将显示在弹出的窗体上。
要点
首先需要得到要查询的Feature对象。使用IIdentify接口的Identify方法可以对给定的位置进行查询，得到结果为IIdentifyObj对象的数组。然后通过为IIdentifyObj对象设置IFeatureIdentifyObj查询接口，即可进一步得到Feature对象。因为IFeatureIdentifyObj接口的Feature属性具有只写（write only）属性，故又用到另一个接口IRowIdentifyObj。
得到Feature对象后即可操作其Fields属性和Value属性，得到其属性字段名和值。
程序说明
在窗体上使用了MSFlexGrid Control 6.0来显示查询结果。所以本例也演示了MSFlexGrid控件的使用方法。
窗体名： frmResult
MSFlexGrid控件名： flxAttr
标签控件名： lblLocation （标签用来显示查询位置的地理坐标）
代码
Private Sub UIT_Identify_MouseDown(ByVal button As Long, ByVal shift As Long, _
ByVal x As Long, ByVal y As Long)
Dim pMxApplication As IMxApplication
Dim pMxDocument As IMxDocument
Dim pMap As IMap
Dim pPoint As IPoint
Dim pIDArray As IArray
Dim pIdentify As IIdentify
Dim pFeatureIdentifyObj As IFeatureIdentifyObj
Dim pIdentifyObj As IIdentifyObj
Dim pRowIdentifyObj As IRowIdentifyObject
Dim pFeature As IFeature
Dim pFields As IFields
Dim pField As IField
Dim iFieldIndex As Integer
Dim iLayerIndex As Integer
Dim sShape As String
On Error GoTo ErrorHandler
Set pMxApplication = Application
Set pMxDocument = Application.Document
Set pMap = pMxDocument.FocusMap
'Identify from TOP layer to BOTTOM, exit loop since one Feature identified
For iLayerIndex = 0 To pMap.LayerCount - 1
Set pIdentify = pMap.Layer(iLayerIndex)
'Convert x and y to map units
Set pPoint = pMxApplication.Display.DisplayTransformation.ToMapPoint(x, y)
'Set label on the form, coordinates would have 6 digits behind decimal point
frmResult.lblLocation = "Location:(" & Format(pPoint.x, "##0.000000") & "," _
& Format(pPoint.y, "##0.000000") & ")"
Set pIDArray = pIdentify.Identify(pPoint)
'Get the FeatureIdentifyObject
If Not pIDArray Is Nothing Then
Set pFeatureIdentifyObj = pIDArray.Element(0)
Set pIdentifyObj = pFeatureIdentifyObj
pIdentifyObj.Flash pMxApplication.Display
'Feature property of FeatureIdentifyObject has write only access
Set pRowIdentifyObj = pFeatureIdentifyObj
Set pFeature = pRowIdentifyObj.Row
Set pFields = pFeature.Fields
'Set the MSFlexGrid control on form te display identify result
With frmResult.flxAttr
.AllowUserResizing = flexResizeColumns
.ColAlignment(1) = AlignmentSettings.flexAlignLeftCenter
.ColWidth(0) = 1500
.ColWidth(1) = 1800
'Add header to MSFlexGrid control
.Rows = pFields.FieldCount + 1
.Cols = 2
.FixedRows = 1
.FixedCols = 0
.TextMatrix(0, 0) = "Field"
.TextMatrix(0, 1) = "Value"
For iFieldIndex = 0 To pFields.FieldCount - 1
Set pField = pFields.Field(iFieldIndex)
'Set field "Field" of the MSFlex control
.TextMatrix(iFieldIndex + 1, 0) = pField.Name
'Set field "Value" of the MSFlex control
Select Case pField.Type
Case esriFieldTypeOID
.TextMatrix(iFieldIndex + 1, 1) = pFeature.OID
Case esriFieldTypeGeometry
'The function QueryShapeType return a String that
' correspond with the esriGeoemtryType const
sShape = QueryShapeType(pField.GeometryDef.GeometryType)
.TextMatrix(iFieldIndex + 1, 1) = sShape
Case Else
.TextMatrix(iFieldIndex + 1, 1) = pFeature.Value(iFieldIndex)
End Select
Next iFieldIndex
End With
frmResult.Show modal
Exit Sub
End If
Next iLayerIndex
'If code goes here, no Feature was indentified, clear the MSFlex control's content
' and show a message
frmResult.flxAttr.Clear
MsgBox "No feature identified."
Exit Sub
ErrorHandler:
MsgBox Err.Description
End Sub
Public Function QueryShapeType(ByVal enuGeometryType As esriGeometryType) As String
Dim sShapeType As String
Select Case enuGeometryType
Case esriGeometryPolyline
sShapeType = "Polyline"
Case esriGeometryPolygon
sShapeType = "Polygon"
Case esriGeometryPoint
sShapeType = "Point"
Case esriGeometryMultipoint
sShapeType = "Multipoint"
Case esriGeometryNull
sShapeType = "Unknown"
Case esriGeometryLine
sShapeType = "Line"
Case esriGeometryCircularArc
sShapeType = "CircularArc"
Case esriGeometryEllipticArc
sShapeType = "EllipticArc"
Case esriGeometryBezier3Curve
sShapeType = "BezierCurve"
Case esriGeometryPath
sShapeType = "Path"
Case esriGeometryRing
sShapeType = "Ring"
Case esriGeometryEnvelope
sShapeType = "Envelope"
Case esriGeometryAny
sShapeType = "Any valid geometry"
Case esriGeometryBag
sShapeType = "GeometryBag"
Case esriGeometryMultiPatch
sShapeType = "MultiPatch"
Case esriGeometryTriangleStrip
sShapeType = "TriangleStrip"
Case esriGeometryTriangeFan
sShapeType = "TriangleFan"
Case esriGeometryRay
sShapeType = "Ray"
Case esriGeometrySphere
sShapeType = "Sphere"
Case Else
sShapeType = "Unknown!"
End Select
QueryShapeType = sShapeType
End Function
要点
首先需要得到要查询的Feature对象。使用IIdentify接口的Identify方法可以对给定的位置进行查询，得到结果为IIdentifyObj对象的数组。然后通过为IIdentifyObj对象设置IFeatureIdentifyObj查询接口，即可进一步得到Feature对象。因为IFeatureIdentifyObj接口的Feature属性具有只写（write only）属性，故又用到另一个接口IRowIdentifyObj。
得到Feature对象后即可操作其Fields属性和Value属性，得到其属性字段名和值。
程序说明
在窗体上使用了MSFlexGrid Control 6.0来显示查询结果。所以本例也演示了MSFlexGrid控件的使用方法。
窗体名： frmResult
MSFlexGrid控件名： flxAttr
标签控件名： lblLocation （标签用来显示查询位置的地理坐标）
代码
Private Sub UIT_Identify_MouseDown(ByVal button As Long, ByVal shift As Long, _
ByVal x As Long, ByVal y As Long)
Dim pMxApplication As IMxApplication
Dim pMxDocument As IMxDocument
Dim pMap As IMap
Dim pPoint As IPoint
Dim pIDArray As IArray
Dim pIdentify As IIdentify
Dim pFeatureIdentifyObj As IFeatureIdentifyObj
Dim pIdentifyObj As IIdentifyObj
Dim pRowIdentifyObj As IRowIdentifyObject
Dim pFeature As IFeature
Dim pFields As IFields
Dim pField As IField
Dim iFieldIndex As Integer
Dim iLayerIndex As Integer
Dim sShape As String
On Error GoTo ErrorHandler
Set pMxApplication = Application
Set pMxDocument = Application.Document
Set pMap = pMxDocument.FocusMap
'Identify from TOP layer to BOTTOM, exit loop since one Feature identified
For iLayerIndex = 0 To pMap.LayerCount - 1
Set pIdentify = pMap.Layer(iLayerIndex)
'Convert x and y to map units
Set pPoint = pMxApplication.Display.DisplayTransformation.ToMapPoint(x, y)
'Set label on the form, coordinates would have 6 digits behind decimal point
frmResult.lblLocation = "Location:(" & Format(pPoint.x, "##0.000000") & "," _
& Format(pPoint.y, "##0.000000") & ")"
Set pIDArray = pIdentify.Identify(pPoint)
'Get the FeatureIdentifyObject
If Not pIDArray Is Nothing Then
Set pFeatureIdentifyObj = pIDArray.Element(0)
Set pIdentifyObj = pFeatureIdentifyObj
pIdentifyObj.Flash pMxApplication.Display
'Feature property of FeatureIdentifyObject has write only access
Set pRowIdentifyObj = pFeatureIdentifyObj
Set pFeature = pRowIdentifyObj.Row
Set pFields = pFeature.Fields
'Set the MSFlexGrid control on form te display identify result
With frmResult.flxAttr
.AllowUserResizing = flexResizeColumns
.ColAlignment(1) = AlignmentSettings.flexAlignLeftCenter
.ColWidth(0) = 1500
.ColWidth(1) = 1800
'Add header to MSFlexGrid control
.Rows = pFields.FieldCount + 1
.Cols = 2
.FixedRows = 1
.FixedCols = 0
.TextMatrix(0, 0) = "Field"
.TextMatrix(0, 1) = "Value"
For iFieldIndex = 0 To pFields.FieldCount - 1
Set pField = pFields.Field(iFieldIndex)
'Set field "Field" of the MSFlex control
.TextMatrix(iFieldIndex + 1, 0) = pField.Name
'Set field "Value" of the MSFlex control
Select Case pField.Type
Case esriFieldTypeOID
.TextMatrix(iFieldIndex + 1, 1) = pFeature.OID
Case esriFieldTypeGeometry
'The function QueryShapeType return a String that
' correspond with the esriGeoemtryType const
sShape = QueryShapeType(pField.GeometryDef.GeometryType)
.TextMatrix(iFieldIndex + 1, 1) = sShape
Case Else
.TextMatrix(iFieldIndex + 1, 1) = pFeature.Value(iFieldIndex)
End Select
Next iFieldIndex
End With
frmResult.Show modal
Exit Sub
End If
Next iLayerIndex
'If code goes here, no Feature was indentified, clear the MSFlex control's content
' and show a message
frmResult.flxAttr.Clear
MsgBox "No feature identified."
Exit Sub
ErrorHandler:
MsgBox Err.Description
End Sub
Public Function QueryShapeType(ByVal enuGeometryType As esriGeometryType) As String
Dim sShapeType As String
Select Case enuGeometryType
Case esriGeometryPolyline
sShapeType = "Polyline"
Case esriGeometryPolygon
sShapeType = "Polygon"
Case esriGeometryPoint
sShapeType = "Point"
Case esriGeometryMultipoint
sShapeType = "Multipoint"
Case esriGeometryNull
sShapeType = "Unknown"
Case esriGeometryLine
sShapeType = "Line"
Case esriGeometryCircularArc
sShapeType = "CircularArc"
Case esriGeometryEllipticArc
sShapeType = "EllipticArc"
Case esriGeometryBezier3Curve
sShapeType = "BezierCurve"
Case esriGeometryPath
sShapeType = "Path"
Case esriGeometryRing
sShapeType = "Ring"
Case esriGeometryEnvelope
sShapeType = "Envelope"
Case esriGeometryAny
sShapeType = "Any valid geometry"
Case esriGeometryBag
sShapeType = "GeometryBag"
Case esriGeometryMultiPatch
sShapeType = "MultiPatch"
Case esriGeometryTriangleStrip
sShapeType = "TriangleStrip"
Case esriGeometryTriangeFan
sShapeType = "TriangleFan"
Case esriGeometryRay
sShapeType = "Ray"
Case esriGeometrySphere
sShapeType = "Sphere"
Case Else
sShapeType = "Unknown!"
End Select
QueryShapeType = sShapeType
End Function
313
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
