Уважаемые знатоки!

Question

Раскажите чайнику.

Есть координаты полигона, заданные как X,Y<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" />

Есть пустой слой Polygon.

Уважаемые знатоки! Как с помощью VBA на этом слое отразить по этим координатам полигон. Кто-нибудь сбросьте текст программы.  

Заранее благодарна

Answer 1

'Скорее всего Вам необходимо сформировать шейп-файл с 'добавленными полигонами и добавить его в качестве слоя

'попробуйте использовать эту процедуру

 

'Эта процедура показывает последовательные шаги формирования шейп-файла.
' Создание нового шейп-файла

Public Sub CreateShapefile()

  Const strFolder As String = "C:\Test_Data"
  Const strName As String = "MyShapeFile" ' Note! расширение .shp  для файла непозволительно
  Const strShapeFieldName As String = "Shape"
 
  ' Open the folder to contain the shapefile as a workspace
  Dim pFWS As IFeatureWorkspace
  Dim pWorkspaceFactory As IWorkspaceFactory
  Set pWorkspaceFactory = New ShapefileWorkspaceFactory
  Set pFWS = pWorkspaceFactory.OpenFromFile(strFolder, 0)
 
  ' Set up a simple fields collection
  Dim pFields As IFields
  Dim pFieldsEdit As IFieldsEdit
  Set pFields = New esriCore.Fields
  Set pFieldsEdit = pFields ' устанавливаю поля редактируемыми!
 
  Dim pField As IField
  Dim pFieldEdit As IFieldEdit
 
  ' Создаю поле shape
  ' которое необходимо для определения геометрии с пространственной ссылкой
  Set pField = New esriCore.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 = esriGeometryPolygon 'esriGeometryPoint
    Set .SpatialReference = New UnknownCoordinateSystem
  End With
  Set pFieldEdit.GeometryDef = pGeomDef
  pFieldsEdit.AddField pField

  ' Добавляю дополнительное текстовое поле esriFieldTypeString
  Set pField = New esriCore.Field
  Set pFieldEdit = pField
  With pFieldEdit
      .Length = 30
      .Name = "Name"
      .Type = esriFieldTypeString
  End With
  pFieldsEdit.AddField pField
 
  ' добавляю дополнительное целочисленное поле
   
  Set pField = New esriCore.Field
  Set pFieldEdit = pField
  With pFieldEdit
      .Length = 5
      .AliasName = "Object_Number"
      .Name = "Numb"
      .Type = esriFieldTypeSingle
  End With
  pFieldsEdit.AddField pField
 
 
 
 
  ' Создаю shapefile
  ' (some parameters apply to geodatabase options and can be defaulted as Nothing)
  Dim pFeatClass As IFeatureClass
 
  Dim pWorkspaceEdit As IWorkspaceEdit
  Set pWorkspaceEdit = pFWS
  ' начинаю редактирование шейпа без возможности отмены внесенных изменений
  pWorkspaceEdit.StartEditing False
  pWorkspaceEdit.StartEditOperation
  Dim pUID As IUID
  Set pUID = New UID
  pUID.Value = "esriCore.Feature"

  Set pFeatClass = pFWS.CreateFeatureClass(strName, pFields, pUID, _
                                           Nothing, esriFTSimple, strShapeFieldName, "")
 
  Dim i As Integer
  i = pFeatClass.FeatureCount(Nothing) 'получаю количество записей в шейп-файле
 
' начинаю редактировать созданный шейп!!!
' заполнять значение полей и добавлять записи
  Dim pRow As IRow
  Dim pFlds As IFields
  Dim lSFld As Long
  
  
  

    Dim Num_fields As Long
   
    Dim pPt1 As IPoint, pPt2 As IPoint, pPt3 As IPoint, pPt4 As IPoint
    Dim pPt5 As IPoint
   
    Set pPt1 = New Point
    Set pPt2 = New Point
    Set pPt3 = New Point
    Set pPt4 = New Point
    Set pPt5 = New Point
   
    'собственно назначаю значения координат полигона
    pPt1.PutCoords 75.5, 80.3
    pPt2.PutCoords 76.5, 81.5
    pPt3.PutCoords 77.1, 82.3
    pPt4.PutCoords 76.4, 81.8
    pPt5.PutCoords 75.5, 80.3
  ' занесение геометрии типа полигон
  Dim myptcol As IPointCollection
  Set myptcol = New Polygon ' определяю коллекцию как набор точек полигона
  Dim ptCnt As Long
   
  myptcol.AddPoint pPt1
  myptcol.AddPoint pPt2
  myptcol.AddPoint pPt3
  myptcol.AddPoint pPt4
  myptcol.AddPoint pPt5
 
   ptCnt = myptcol.PointCount 'добавил точки в коллекцию
   ' теперь надо сформировать из этой коллекции полигон
Dim X As Double, Y As Double

 Dim pFeatCursor As IFeatureCursor
 Set pFeatCur = pFeatClass.Insert(True)
       
   
   
    'Выполняю 1-ю запись полигона  и атрибутов
   
    Set pFeature = pFeatClass.CreateFeature
    Set pFlds = pFeature.Fields
    Set pFeature.Shape = myptcol 'pPt1
    Num_fields = pFlds.FieldCount - 1
    pFeature.Value(pFeature.Fields.FindField("Numb")) = 333
    pFeature.Value(pFeature.Fields.FindField("Name")) = "Klava"
    pFeature.Store
  
    
  
  i = pFeatClass.FeatureCount(Nothing)
 
  ' конец редактирования шейпа!!!
  pWorkspaceEdit.StopEditOperation
  pWorkspaceEdit.StopEditing True

' Здесь Вам придется самой дописать код обеспечивающий 'добавление слоя

 

End Sub