banniere

Le portail francophone de la géomatique


Toujours pas inscrit ? Mot de passe oublié ?
Nom d'utilisateur    Mot de passe              Toujours pas inscrit ?   Mot de passe oublié ?

Annonce

Rencontres QGIS 2025

L'appel à participation est ouvert jusqu'au 19 janvier 2025!

#1 Tue 23 September 2008 12:31

gfagot
Participant occasionnel
Date d'inscription: 19 Sep 2008
Messages: 12

[ArcMap 9.2] Mise à jour des points en vue géo

Bonjour,

Je n'arrive pas à mettre à jour en visu les données géométriques que j'ai chargé dans la base Access.
J'ai crée une géométrie, une spatiale référence, une pFeatureWorkspace, une DataTable, une layer

Code:

...
Set pfeatureClass = pFeatureWorkspace.CreateFeatureClass("myLignes", pFieldsEdit, Nothing, Nothing, esriFTSimple, "shape", "")
Set DataTable = pFeatureWorkspace.OpenTable("myLignes")
...
Set pflayer = New FeatureLayer
Set pflayer.FeatureClass = pfeatureClass
...
pmxdoc.AddLayer pflayer
pmxdoc.ActiveView.Refresh

J'ai donc bien des Layers mais pas de données géométriques.

D'avance merci de vos idées.

Hors ligne

 

#2 Tue 23 September 2008 12:46

Tnarbiv
Participant assidu
Lieu: Véretz
Date d'inscription: 5 Sep 2005
Messages: 392

Re: [ArcMap 9.2] Mise à jour des points en vue géo

il y a aussi un

Code:

pmxdoc.updatecontents

pour mettre à jour la table des matières


Ayez le réflexe "Développement Durable": N'imprimez ce message que si nécessaire.

Hors ligne

 

#3 Tue 23 September 2008 16:28

gfagot
Participant occasionnel
Date d'inscription: 19 Sep 2008
Messages: 12

Re: [ArcMap 9.2] Mise à jour des points en vue géo

Ca ne marche toujours pas,
lorsque j'utilise ArcCatalog je n'ai pas de messages d'erreurs lors de l'affichage Géométrique. Mais je ne vois pas les points, alors qu'en mode Table j'ai bien des données avec un Object ID, une Shape Point,un Nom (String) , un X (double), un Y (double) et une Valeur (double).
Dois je créer les points à la main ? (New Point) Pour le moment je pensais qu'une fois qu'ils étaient dans la base, je pourrais les voir à l'écran.
J'utilise comme systéme de coordonnées "WGS 1984 UTM Zone 31N.prj"

Je laisse le code total peut-être cela pourrait vous donner des idées ?
D'avance merci

Code:

Public Sub CreerUneGeoTable()


' CREATION DATABASEES

Dim pAccessWFactory As IWorkspaceFactory
Set pAccessWFactory = New AccessWorkspaceFactory
Dim strMdbFolder As String, strMdb As String
strMdbFolder = "D:\CEA_SIG\test\DataBases"
strMdb = "mygdb"
Dim pWorkspaceName As IWorkspaceName
Set pWorkspaceName = pAccessWFactory.Create _
(strMdbFolder, strMdb, Nothing, 0)

'CREATION GEOMETRIE

Dim pGeomDef As IGeometryDefEdit
Set pGeomDef = New GeometryDef
'Création de la SpatialReference à partir d'un fichier .PRJ
Dim pSpatRefFact As ISpatialReferenceFactory
Set pSpatRefFact = New SpatialReferenceEnvironment
Dim pSR As ISpatialReference
Set pSR = pSpatRefFact.CreateESRISpatialReferenceFromPRJFile _
("D:\CEA_SIG\Presentation_CE\Projections_CE\WGS 1984 UTM Zone 31N.prj")
'Définition du domaine X/Y
pSR.SetFalseOriginAndUnits 0, 0, 10 '(xmin=0, ymin=0, précision de 1000 de m)
With pGeomDef
.GeometryType = esriGeometryPoint '(classe d'entité ligne)
.GridCount = 1
.GridSize(0) = 10000
.AvgNumPoints = 2
.HasM = False
.HasZ = False
Set .SpatialReference = pSR
End With

'CREATION CHAMPS
Dim pNomField As IFieldEdit
Set pNomField = New Field
Dim pShapeField As IFieldEdit
Set pShapeField = New Field
Dim pOIDField As IFieldEdit

Dim X_Field As IFieldEdit
Set X_Field = New Field
X_Field.Name = "X"
X_Field.Type = esriFieldTypeDouble

Dim Y_Field As IFieldEdit
Set Y_Field = New Field
Y_Field.Name = "Y"
Y_Field.Type = esriFieldTypeDouble

Dim Valeur_Field As IFieldEdit
Set Valeur_Field = New Field
Valeur_Field.Name = "Valeur"
Valeur_Field.Type = esriFieldTypeDouble

Set pOIDField = New Field
pOIDField.Name = "OBJECTID"
pOIDField.Type = esriFieldTypeOID
pNomField.Name = "Nom"
pNomField.Type = esriFieldTypeString
pNomField.Length = 100

pShapeField.Name = "Shape"
pShapeField.Type = esriFieldTypeGeometry



Set pShapeField.GeometryDef = pGeomDef
'Ajout de ces champs à une nouvelle collection de champs
Dim pFieldsEdit As IFieldsEdit
Set pFieldsEdit = New Fields
pFieldsEdit.AddField pOIDField
pFieldsEdit.AddField pShapeField
pFieldsEdit.AddField pNomField
pFieldsEdit.AddField X_Field
pFieldsEdit.AddField Y_Field
pFieldsEdit.AddField Valeur_Field


'FEATURE CLASSE
Dim pName As IName
Set pName = pWorkspaceName 'QI entre IWorkspaceName et IName
Dim pWorkspace As IWorkspace
Set pWorkspace = pName.Open
Dim pFeatureWorkspace As IFeatureWorkspace
Set pFeatureWorkspace = pWorkspace 'QI
Dim pfeatureClass As IFeatureClass
Set pfeatureClass = pFeatureWorkspace.CreateFeatureClass("myLignes", pFieldsEdit, Nothing, Nothing, esriFTSimple, "shape", "")
Dim pFeaturedataSet As IFeatureDataset
'Set pFeaturedataSet = pFeatureWorkspace.CreateFeatureDataset _
("mydataset", pSR)
''Set pfeatureClass = pFeaturedataSet.CreateFeatureClass _
("myLignes", pFieldsEdit, Nothing, Nothing, esriFTSimple, "shape", "")

' on ajoute la layer

Dim pflayer As IFeatureLayer
Set pflayer = New FeatureLayer
Set pflayer.FeatureClass = pfeatureClass
pflayer.Name = pfeatureClass.AliasName

pflayer.DataSourceType = True



Dim DataTable As ITable

Set DataTable = pFeatureWorkspace.OpenTable("myLignes")



Dim pRowBuffer As IRowBuffer
Dim pCursor As ICursor

Set pCursor = DataTable.Insert(False)
For i = 1 To 20
Set pCursor = DataTable.Insert(False)
Set pRowBuffer = DataTable.CreateRowBuffer

pRowBuffer.Value(pRowBuffer.Fields.FindField("Nom")) = "Parc"
pRowBuffer.Value(pRowBuffer.Fields.FindField("X")) = 782000 + 10 * i
pRowBuffer.Value(pRowBuffer.Fields.FindField("Y")) = 2284243 + 10 * i
pRowBuffer.Value(pRowBuffer.Fields.FindField("Valeur")) = 100 + i

'***Transfert des valeurs contenu dans pRowBuffer vers le curseur
pCursor.InsertRow pRowBuffer
Next i


pflayer.DisplayField = True
pflayer.ShowTips = True
pflayer.Visible = True

Dim pmxdoc As IMxDocument
Set pmxdoc = ThisDocument
' on ajoute cette nouvelle couche à la carte

pmxdoc.AddLayer pflayer
pmxdoc.ActiveView.Refresh
pmxdoc.UpdateContents


Dim pGeoDataset As IGeoDataset
Set pGeoDataset = pflayer
Dim spatialref As ISpatialReference
Set pspatialref = pGeoDataset.SpatialReference

pflayer.DisplayField = True
pflayer.ShowTips = True
pflayer.Visible = True

pmxdoc.UpdateContents

...

Hors ligne

 

Pied de page des forums

Powered by FluxBB