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

1 Private Sub UIButtonControl1_Click()   2 Dim pApp As IApplication  3 Set pApp = Application  4 Dim pDoc As IMxDocument  5 Set pDoc = pApp.Document  6 Dim pMap As IMap  7 Set pMap = pDoc.FocusMap  8 Dim pLayer As ILayer  9 Set pLayer = pDoc.SelectedLayer 10  11 If (pLayer Is Nothing) Then MsgBox "请选择要计算的图层！": Exit Sub 12 Dim pFeatLayer As IFeatureLayer 13 Set pFeatLayer = pLayer 14  15 Dim pFeatClass As IFeatureClass 16 Set pFeatClass = pFeatLayer.FeatureClass 17  18 Dim outStr As String 19  20 Select Case pFeatClass.ShapeType '1为point，3为polyline，4为polygon 21     Case 1 22         MsgBox ("当前图层为点图层") 23         Call compoint(pFeatClass, outStr) 24     Case 3 25         MsgBox ("当前图层为面图层") 26         Call compolyline(pFeatClass, outStr) 27     Case 4 28         MsgBox ("当前图层为面图层") 29         Call compolygon(pFeatClass, outStr) 30     Case Else 31 End Select 32  33 Dim msgStr() As String 34 Dim maxi As Integer 35 ReDim Preserve msgStr(0) 36 maxi = -1 37 For i = 0 To CInt((Len(outStr) / 640)) 38     maxi = maxi + 1 39     ReDim Preserve msgStr(maxi) 40     msgStr(maxi) = Mid(outStr, 640 * i + 1, 640) 41 Next 42 For i = 0 To UBound(msgStr) - 1 43     MsgBox (msgStr(i)) 44 Next 45  46  47  48 End Sub//获取点图层坐标信息  49 Private Function compoint(pFeatClass As IFeatureClass, ByRef outStr As String) 50 Dim pPnt As IPoint 51  52 Dim pFeatCursor As IFeatureCursor 53 Set pFeatCursor = pFeatClass.Search(Nothing, False) 54  55 Dim pFeature As IFeature 56 Set pFeature = pFeatCursor.NextFeature 57 Dim sName As String 58 Do Until pFeature Is Nothing 59     Set pPnt = pFeature.Shape 60     sName = pFeature.Value(pFeature.Fields.FindField("CITY_NAME")) 61     Set pFeature = pFeatCursor.NextFeature 62     outStr = outStr + sName + ": " + Str(pPnt.X) + "," + Str(pPnt.Y) 63     If pPnt.Z <> Null Then outStr = outStr + Str(pPnt.Z) 64     outStr = outStr + vbNewLine 65 Loop 66  67 End Function 68 //获取线图层长度信息等属性信息  69 Private Function compolyline(pFeatClass As IFeatureClass, ByRef outStr As String) 70 Dim pPolyline As IPolyline 71 Dim pFeatCursor As IFeatureCursor 72 Set pFeatCursor = pFeatClass.Search(Nothing, False) 73 Dim pFeature As IFeature 74 Set pFeature = pFeatCursor.NextFeature 75 Dim itab As Integer 76 Dim sName As String 77  78 Do Until pFeature Is Nothing 79     itab = 1 + itab 80     Set pPolyline = pFeature.Shape 81     sName = pFeature.Value(pFeature.Fields.FindField("NAME")) 82     Set pFeature = pFeatCursor.NextFeature 83     outStr = outStr + "元素" + CStr(itab) + ": " + sName + "，长度为：" + Str(pPolyline.Length) + "；" + vbNewLine 84 Loop 85  86 End Function 87// 获取多边形图层信息等属性信息  88 Private Function compolygon(pFeatClass As IFeatureClass, ByRef outStr As String) 89 Dim pArea As IArea 90 Dim pPolygon As IPolygon 91 Dim pFeatCursor As IFeatureCursor 92 Set pFeatCursor = pFeatClass.Search(Nothing, False) 93 Dim pPnt As IPoint 94 Dim pFeature As IFeature 95 Set pFeature = pFeatCursor.NextFeature 96 Dim sName As String 97 Do Until pFeature Is Nothing 98     Set pPolygon = pFeature.Shape 99     Set pArea = pPolygon100     Set pPnt = pArea.Centroid101     sName = pFeature.Value(pFeature.Fields.FindField("STATE_NAME"))102     Set pFeature = pFeatCursor.NextFeature103     outStr = outStr + sName + ": " + _104         "周长是：" + Str(pPolygon.Length) + _105         ",面积是：" + Str(pArea.Area) + _106         ",重心是：(" + Str(pPnt.X) + "," + Str(pPnt.Y) + ")"107     If pPnt.Z <> Null Then outStr = outStr + Str(pPnt.Z)108     outStr = outStr + vbNewLine109 Loop110 111 End Function