自动生成9*9个格子,然后Clip16万个points(Arcmap+vba+手动)

发现个人的功力还是不够,学到的很多,但是忘记的也不少,需要把学习到的管理起来,方便以后的查询,而且把常用的做成工具直接调用。
总结与反思是非常重要的,管理也是毋庸置疑的重要,now,make my resources perfect.

Dim i As Integer
Dim k As Integer


Dim j As Integer
j = 2000
Dim x As Long
Dim y As Long
x = 108000
y = 2454000



Dim pMxDoc As IMxDocument
Set pMxDoc = Application.Document

Dim pMap As IMap
Set pMap = pMxDoc.FocusMap

Dim pActiveView As IActiveView
Set pActiveView = pMxDoc.FocusMap

Dim pFeatureClass As IFeatureClass
Dim pFeatureLayer As IFeatureLayer

For k = 0 To 8

x = 108000
For i = 0 To 8

Set pFeatureLayer = pMap.Layer(i + k * 9)
Set pFeatureClass = pFeatureLayer.FeatureClass

    Dim pFeature As IFeature
    Set pFeature = pFeatureClass.CreateFeature
    
    Dim pPointCollection4 As IPointCollection4
    Set pPointCollection4 = New Polygon
    
    Dim pPolygon As IPolygon
    Set pPolygon = pPointCollection4
    
    
    Dim pPoint As IPoint

    Set pPoint = New Point
    pPoint.PutCoords x, y
    pPointCollection4.AddPoint pPoint

    
    Set pPoint = New Point
    pPoint.PutCoords x + j, y
    pPointCollection4.AddPoint pPoint
    
    Set pPoint = New Point
    pPoint.PutCoords x + j, y - j
    pPointCollection4.AddPoint pPoint
    
    Set pPoint = New Point
    pPoint.PutCoords x, y - j
    pPointCollection4.AddPoint pPoint
    
    pPolygon.Close
    Set pFeature.Shape = pPolygon
    pFeature.Store
    x = x + 2000
       
Next i

y = y + 2000
Next k

    pActiveView.Refresh

你可能感兴趣的:(map)