Select to view content in your preferred language

VBA Add Point so Shape - Zoom Error

525
1
05-04-2010 09:36 AM
HendrikPischel
Emerging Contributor
Hello,
i just want to add a single Point Feature to a FeatureClass.

If got this Shape File.
Datatyp: Shapefile Feature Class
Shapefile: ...\Adresse.shp
Geometrietyp: Point
Layername:       > 1:2000

    Dim pMxDocument As IMxDocument
    Dim pMap As IMap
    '
    Dim pLayer As ILayer
    Dim pFeatureLayer As IFeatureLayer
    Dim pFeatureClass As IFeatureClass
    Dim pFeature As IFeature
    Dim pPoint As IPoint

    Dim pEditLayers As IEditLayers
    Dim pEditor As IEditor

    Set pMxDocument = Application.Document
    Set pMap = pMxDocument.FocusMap
    
' this Function searches for the layer named ... and returns the ILayer.
    Set pLayer = FindeLayer("> 1:2000", pMap)
    Set pFeatureLayer = pLayer

    Set pFeatureClass = pFeatureLayer.FeatureClass
    
    Set pFeature = pFeatureClass.CreateFeature
    
    Set pPoint = New Point
    
    pPoint.PutCoords gbl_SuchQdr_M_X, gbl_SuchQdr_M_Y
    
    Set pFeature.Shape = pPoint
    
    pFeature.Store
    
    pMxDocument.ActivatedView.Refresh


In the End of this i have a Point added to my shape file. But if i check the layers extends these are not limited to the the point coordinates and if i try to zoom to the layer it's only displayed at a very high range.
If i just delete the point and place it with the ArcGIS Edit function there is no zooming error.
So far i think something is worng with my code - can you help me?

Regards,
Hendrik
0 Kudos
1 Reply
HendrikPischel
Emerging Contributor
Well i just found a way to fix the error but i'm not sure if i realy need this.

Public Sub AddAdresseToLayer()
    ' ***************************************************************
    ' In den Layer der Adressen den aktuellen Punkt der Adresse einfügen
    ' ***************************************************************
    Dim pMxDocument As IMxDocument
    Dim pMap As IMap
    Set pMxDocument = Application.Document
    Set pMap = pMxDocument.FocusMap
    
    ' Layer suchen
    Dim pLayer As ILayer
    Dim pFeatureLayer As IFeatureLayer
    Set pLayer = FindeLayer("Adresse", pMap)
    Set pFeatureLayer = pLayer
    
    ' FeatureClass zuweisen
    Dim pFeatureClass As IFeatureClass
    Set pFeatureClass = pFeatureLayer.FeatureClass
    
    ' Workspace öffnen und Edit session starten
    Dim pDataset As IDataset
    Set pDataset = pFeatureClass
    
    Dim pWorkspace As IWorkspace
    Set pWorkspace = pDataset.Workspace
    
    Dim pWorkspaceEdit As IWorkspaceEdit
    Set pWorkspaceEdit = pWorkspace
    
    pWorkspaceEdit.StartEditing True
    pWorkspaceEdit.StartEditOperation
    
    ' Feature & Punkt erzeugen
    Dim pFeature As IFeature
    Set pFeature = pFeatureClass.CreateFeature
    
    Dim pPoint As IPoint
    Set pPoint = New Point
    pPoint.PutCoords gbl_SuchQdr_M_X, gbl_SuchQdr_M_Y
    
    ' Punkt in Feature einfügen
    Set pFeature.Shape = pPoint
    
    ' Feature speichern
    pFeature.Store
    
    ' Edit beenden
    pWorkspaceEdit.StopEditOperation
    pWorkspaceEdit.StopEditing True

    pMxDocument.ActivatedView.Refresh
End Sub


I thought that i didn't need the edit session.

Regards, Hendrik
0 Kudos