Помогите пожалуйста ни как не могу понять в чем проблема!!!
Public Sub CreateShapefile()
Dim pFSO As Object, sFCName As String
sFCName = "d:\temp\myshape.shp" 'файл без имени
Set pFSO = CreateObject("Scripting.FileSystemObject")
Dim pFWS As IFeatureWorkspace
Dim pWorkspaceFactory As IWorkspaceFactory
Set pWorkspaceFactory = New ShapefileWorkspaceFactory
Set pFWS = pWorkspaceFactory.OpenFromFile("d:\temp", 0)
Dim pFields As IFields
Dim pFieldsEdit As IFieldsEdit
Set pFields = New Fields
Set pFieldsEdit = pFields
Dim pField As IField
Dim pFieldEdit As IFieldEdit
Set pField = New Field
Set pFieldEdit = pField
pFieldEdit.Name = strShapeFieldName
pFieldEdit.Type = esriFieldTypeGeometry
Dim pGeomDef As IGeometryDef
Dim pGeomDefEdit As IGeometryDefEdit
Set pGeomDef = New GeometryDef
Set pGeomDefEdit = pGeomDef
With pGeomDefEdit
.GeometryType = esriGeometryPoint
Set .SpatialReference = New UnknownCoordinateSystem 'система кординат
End With
Set pFieldEdit.GeometryDef = pGeomDef
pFieldsEdit.AddField pField
Set pField = New Field
Set pFieldEdit = pField
With pFieldEdit
.Length = 30
.Name = "НАПРАВЛЕНИЕ"
.Type = esriFieldTypeString
End With
pFieldsEdit.AddField pField
Set pField = New Field
Set pFieldEdit = pField
With pFieldEdit
.Length = 30
.Name = "СКОРОСТЬ"
.Type = esriFieldTypeString
End With
pFieldsEdit.AddField pField
Set pFeatClass = pFWS.CreateFeatureClass(strName, pFields, Nothing, _
Nothing, esriFTSimple, strShapeFieldName, "")
End Sub
Public Sub AddShapeFile()
Dim pWorkspaceFactory As IWorkspaceFactory
Dim pFeatureWorkspace As IFeatureWorkspace
Dim pFeatureLayer As IFeatureLayer
Dim pMxDocument As IMxDocument
Dim pMap As IMap
Set pWorkspaceFactory = New ShapefileWorkspaceFactory
Set pFeatureWorkspace = pWorkspaceFactory.OpenFromFile("D:\Temp", 0)
Set pFeatureLayer = New FeatureLayer
Set pFeatureLayer.FeatureClass = pFeatureWorkspace.OpenFeatureClass("")
pFeatureLayer.Name = pFeatureLayer.FeatureClass.AliasName
Set pMxDocument = Application.Document
Set pMap = pMxDocument.FocusMap
pMap.AddLayer pFeatureLayer
End Sub
Public Sub StartEditing()
Dim pEditor As IEditor
Dim pID As New UID
Dim pFeatureLayer As IFeatureLayer
Dim pDataset As IDataset
Dim pMap As IMap
Dim pMxDoc As IMxDocument
Dim LayerCount As Integer
Set pMxDoc = Application.Document
Set pMap = pMxDoc.FocusMap
pID = "esriCore.Editor"
Set pEditor = Application.FindExtensionByCLSID(pID)
If pEditor.EditState = esriStateEditing Then Exit Sub
'Start editing the workspace of the first featurelayer you find
For LayerCount = 0 To pMap.LayerCount - 1
If TypeOf pMap.Layer(LayerCount) Is IFeatureLayer Then
Set pFeatureLayer = pMap.Layer(LayerCount)
Set pDataset = pFeatureLayer.FeatureClass
pEditor.StartEditing pDataset.Workspace
Exit For
End If
Next LayerCount
End Sub
Public Sub AddPoint()
Dim edit As IEditSketch
Dim p As IPoint
Set edit = pEditor
Set p = New Point
Dim x As Double
Dim y As Double
x = 61472491264#
y = 27120216734#
p.PutCoords x, y
edit.AddPoint p, True
End Sub
Public Sub ExtractValuesToPoints()
Dim pointDataset As IGeoDataset
Dim valueRaster As IGeoDataset
Dim pExtractionOp As IExtractionOp2
Set pExtractionOp = New RasterExtractionOp
Dim pRas01 As IRaster
Set pRas01 = readRasterFromDisk("c:\data\myRaster1")
Dim pFC01 As IFeatureClass
Set pFC01 = readPointFeatureFromDisk("d:\temp\.shp")
Dim pOutGeoDS As IGeoDataset
Set pOutGeoDS = pExtractionOp.ExtractValuesToPoints(pFC01, pRas01, True)
ответил
17 Окт, 12
от
