Помогите исправит код

0 голосов
спросил 16 Окт, 12 от kog9 (400 баллов) в категории Программные продукты Esri
    Помогите пожалуйста ни как не могу понять в чем проблема!!!

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)

11 Ответы

0 голосов
ответил 16 Окт, 12 от kog9 (400 баллов)
readRasterFromDisk и эта readPointFeatureFromDisk почему эта функция не определена

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 И ПОЧЕМУ ВЫДАЕТ ОШИБКУ ОБЪЕКТ НЕ НАЙДЕН
0 голосов
ответил 16 Окт, 12 от kog9 (400 баллов)
Ребята помогите пожалуйста
0 голосов
ответил 17 Окт, 12 от new_sergei (2,660 баллов)
readRasterFromDisk и эта readPointFeatureFromDisk почему эта функция не определена

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 И ПОЧЕМУ ВЫДАЕТ ОШИБКУ ОБЪЕКТ НЕ НАЙДЕН


Так а где сама функция readRasterFromDisk?
Она есть у вас? Вы полный свой код привели? Или это из какого-то примера?
    
0 голосов
ответил 17 Окт, 12 от kog9 (400 баллов)
http://edndoc.esri.com/arcobjects/9.2/net/shared/geoprocessing/spatial_analyst_tools/extract_values_to_points.htm
Эта часть копировалась от сюда
Нет в библиотеках найти ее не удалось.
Код полный
0 голосов
ответил 17 Окт, 12 от new_sergei (2,660 баллов)
http://edndoc.esri.com/arcobjects/9.2/net/shared/geoprocessing/spatial_analyst_tools/extract_values_to_points.htm
Эта часть копировалась от сюда
Нет в библиотеках найти ее не удалось.
Код полный


Дело в том, что в библиотеках этой функции не будет. Это функция, которая была создана самим пользователем (программистом). Вам тогда надо поискать в других примерах на edndoc где может быть такая функция, или самому написать свою такую функцию, которая бы возвращала IRaster. Для этого тоже надо посмотреть примеры.
Т.е., ошибка у Вас в том, что вы пытаетесь вызвать функцию, которая не является системной, а созданна должна быть именно Вами.
    
0 голосов
ответил 17 Окт, 12 от kog9 (400 баллов)
Спасибо буду искать может вы подскажете почему в этом фрагменте вылетает ошибка (Объект не найден)
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
0 голосов
ответил 17 Окт, 12 от kog9 (400 баллов)
Сеанс редактирование запущен , объект создан а точку все равно добавлять не хочет
0 голосов
ответил 18 Окт, 12 от new_sergei (2,660 баллов)
Спасибо буду искать может вы подскажете почему в этом фрагменте вылетает ошибка (Объект не найден)
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


edit проинициализировался правильно?
    
0 голосов
ответил 19 Окт, 12 от kog9 (400 баллов)
Вроде бы да ошибка вылетает на edit.AddPoint p, True
но компилятор встроенный ArcGis муть
0 голосов
ответил 19 Окт, 12 от new_sergei (2,660 баллов)
Сейчас доступа к ArcGis нет, поэтому не могу точно сказать. А точно есть такая функция у этого интерфейса? Может, пример для другой версии был, а в той версии, в которой Вы пробуете его запустить, функция может по-другому называться. Проверьте.
...