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

 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

 

posted @ 2013-07-29 09:05  Lulee  阅读(849)  评论(0)  编辑  收藏  举报