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 = pPolygon 100 Set pPnt = pArea.Centroid 101 sName = pFeature.Value(pFeature.Fields.FindField("STATE_NAME")) 102 Set pFeature = pFeatCursor.NextFeature 103 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 + vbNewLine 109 Loop 110 111 End Function