| Message |
I wrote a simple code for you.
Paste this code into VBA editor,create the text fiel with coordinates in it,add a polygon layer to ArcMap (polygon will be inserted here) and run CreatePolygonFromText subrutine.
MyCoords.txt shoul look like this:
x1,y1
x2,y2
x3,y3
...
Write me if U have any questions. |
| |
Option Explicit
Public Sub CreatePolygonFromText()
On Error GoTo ErrorHandler
'get document and map
Dim pMxDoc As IMxDocument
Set pMxDoc = ThisDocument
Dim pMap As IMap
Set pMap = pMxDoc.FocusMap
If (pMap.LayerCount = 0) Then Exit Sub
'layer(0) of the map should be a polygon layer
'this is the layer where the polygon will be inserted
Dim pFeatureLayer As IFeatureLayer2
Set pFeatureLayer = pMap.Layer(0)
If (Not pFeatureLayer.ShapeType = esriGeometryPolygon) Then Exit Sub
Dim pFeatureClass As IFeatureClass
Set pFeatureClass = pFeatureLayer.FeatureClass
Dim pDataset As IDataset
Set pDataset = pFeatureClass
Dim pWorkspace As IWorkspace
Set pWorkspace = pDataset.Workspace
Dim pWorkspaceEdit As IWorkspaceEdit
Set pWorkspaceEdit = pWorkspace
Dim pPolygon As IPolygon
'create polygon from coords can be found in the text file
Set pPolygon = GetPolygonFromText("c:\temp\mycoords.txt")
If (pPolygon Is Nothing) Then Exit Sub
'insert polygon to the featureclass
pWorkspaceEdit.StartEditing True
pWorkspaceEdit.StartEditOperation
Dim pFeature As esriCore.IFeature
Set pFeature = pFeatureClass.CreateFeature
Set pFeature.Shape = pPolygon
pFeature.Store
pWorkspaceEdit.StopEditOperation
pWorkspaceEdit.StopEditing True
'refresh map
Dim pActiveView As IActiveView
Set pActiveView = pMap
pActiveView.PartialRefresh esriViewGeography, Nothing, Nothing
Exit Sub
ErrorHandler:
MsgBox Err.Number & vbCrLf & Err.Description, vbCritical
End Sub
Private Function GetPolygonFromText(path As String) As IPolygon
On Error GoTo ErrorHandler
Dim pGeometryCollection As esriCore.IGeometryCollection
Dim pRing As IRing
Dim pPolygon As IPolygon
Dim pPointCollection As IPointCollection
Dim pPoint As IPoint
Dim f As Integer
Dim dblX As Double
Dim dblY As Double
Set pRing = New Ring
Set pPointCollection = pRing
f = FreeFile
Open path For Input As #f
'loop thrugh the text file to get coordinates
Do Until EOF(f)
Input #f, dblX, dblY
Set pPoint = New Point
pPoint.X = dblX
pPoint.Y = dblY
pPointCollection.AddPoint pPoint
Loop
Close #f
'crete polygon from coordibates
Set pGeometryCollection = New Polygon
pGeometryCollection.AddGeometry pRing
Set pPolygon = pGeometryCollection
pRing.Close
Set GetPolygonFromText = pPolygon
Exit Function
ErrorHandler:
MsgBox Err.Number & vbCrLf & Err.Description, vbCritical
End Function
|