Annonce
#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.RefreshJ'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
