ArcMap中用VBA读度矢量图层信息

ArcMap下用VBA操作图层基本的过程了。

 Private Sub UIButtonControl1_Click()
 Dim pApp As IApplication
 Set pApp = Application
 Dim pDoc As IMxDocument
 Set pDoc = pApp.Document
 Dim pMap As IMap
 Set pMap = pDoc.FocusMap
 Dim pLayer As ILayer
 Set pLayer = pDoc.SelectedLayer

 If (pLayer Is Nothing) Then MsgBox "请选择要计算的图层！": Exit Sub
 Dim pFeatLayer As IFeatureLayer
 Set pFeatLayer = pLayer

 Dim pFeatClass As IFeatureClass
 Set pFeatClass = pFeatLayer.FeatureClass

 Dim outStr As String

 Select Case pFeatClass.ShapeType '1为point，3为polyline，4为polygon
     Case
         MsgBox ("当前图层为点图层")
         Call compoint(pFeatClass, outStr)
     Case
         MsgBox ("当前图层为面图层")
         Call compolyline(pFeatClass, outStr)
     Case
         MsgBox ("当前图层为面图层")
         Call compolygon(pFeatClass, outStr)
     Case Else
 End Select

 Dim msgStr() As String
 Dim maxi As Integer
 ReDim Preserve msgStr()
 maxi = -
 For i =  To CInt((Len(outStr) / ))
     maxi = maxi +
     ReDim Preserve msgStr(maxi)
     msgStr(maxi) = Mid(outStr,  * i + , )
 Next
 For i =  To UBound(msgStr) -
     MsgBox (msgStr(i))
 Next

 End Sub
//获取点图层坐标信息
 Private Function compoint(pFeatClass As IFeatureClass, ByRef outStr As String)
 Dim pPnt As IPoint

 Dim pFeatCursor As IFeatureCursor
 Set pFeatCursor = pFeatClass.Search(Nothing, False)

 Dim pFeature As IFeature
 Set pFeature = pFeatCursor.NextFeature
 Dim sName As String
 Do Until pFeature Is Nothing
     Set pPnt = pFeature.Shape
     sName = pFeature.Value(pFeature.Fields.FindField("CITY_NAME"))
     Set pFeature = pFeatCursor.NextFeature
     outStr = outStr + sName + ": " + Str(pPnt.X) + "," + Str(pPnt.Y)
     If pPnt.Z <> Null Then outStr = outStr + Str(pPnt.Z)
     outStr = outStr + vbNewLine
 Loop

 End Function
 //获取线图层长度信息等属性信息
 Private Function compolyline(pFeatClass As IFeatureClass, ByRef outStr As String)
 Dim pPolyline As IPolyline
 Dim pFeatCursor As IFeatureCursor
 Set pFeatCursor = pFeatClass.Search(Nothing, False)
 Dim pFeature As IFeature
 Set pFeature = pFeatCursor.NextFeature
 Dim itab As Integer
 Dim sName As String

 Do Until pFeature Is Nothing
     itab =  + itab
     Set pPolyline = pFeature.Shape
     sName = pFeature.Value(pFeature.Fields.FindField("NAME"))
     Set pFeature = pFeatCursor.NextFeature
     outStr = outStr + "元素" + CStr(itab) + ": " + sName + "，长度为：" + Str(pPolyline.Length) + "；" + vbNewLine
 Loop

 End Function
 87// 获取多边形图层信息等属性信息
 Private Function compolygon(pFeatClass As IFeatureClass, ByRef outStr As String)
 Dim pArea As IArea
 Dim pPolygon As IPolygon
 Dim pFeatCursor As IFeatureCursor
 Set pFeatCursor = pFeatClass.Search(Nothing, False)
 Dim pPnt As IPoint
 Dim pFeature As IFeature
 Set pFeature = pFeatCursor.NextFeature
 Dim sName As String
 Do Until pFeature Is Nothing
     Set pPolygon = pFeature.Shape
     Set pArea = pPolygon
     Set pPnt = pArea.Centroid
     sName = pFeature.Value(pFeature.Fields.FindField("STATE_NAME"))
     Set pFeature = pFeatCursor.NextFeature
     outStr = outStr + sName + ": " + _
         "周长是：" + Str(pPolygon.Length) + _
         ",面积是：" + Str(pArea.Area) + _
         ",重心是：(" + Str(pPnt.X) + "," + Str(pPnt.Y) + ")"
     If pPnt.Z <> Null Then outStr = outStr + Str(pPnt.Z)
     outStr = outStr + vbNewLine
 Loop

 End Function