#1 Thu 18 May 2006 09:45
- Pascal Ogy
- Juste Inscrit !
- Date d'inscription: 1 May 2006
- Messages: 2
Comment exécuter code VBA dans ArcGis 9
J'ai essayé en vain d'exécuter le code VBA ci après dans ArcGIS. Ce code est supposé tracé deux segments de ligne. Quand je lance la fonction rien ne se passe. Merci de m'aider.
Pascal Ogy
Dim pPoint1 As IPoint, pPoint2 As IPointDim pPoint3 As IPoint, pPoint4 As IPointSet pPoint1 = New PointpPoint1.PutCoords 10, 10Set pPoint2 = New PointpPoint2.PutCoords 20, 30Set pPoint3 = New PointpPoint3.PutCoords 40, 50Set pPoint4 = New PointpPoint4.PutCoords 30, 60Dim pGeometryColl As IGeometryCollectionSet pGeometryColl = New PolylineDim pSegmentColl As ISegmentCollectionSet pSegmentColl = New PathDim pLine As ILineSet pLine = New LinepLine.PutCoords pPoint1, pPoint2pSegmentColl.AddSegment pLinepGeometryColl.AddGeometry pSegmentCollSet pSegmentColl = New PathSet pLine = New LinepLine.PutCoords pPoint3, pPoint4pSegmentColl.AddSegment pLinepGeometryColl.AddGeometry pSegmentColl
Hors ligne
#2 Thu 18 May 2006 15:40
Re: Comment exécuter code VBA dans ArcGis 9
Bonjour,
Voila un code qui fonctionne pour la création de points, vous pouvez vous en inspirer.
Je pense que vous avez créer les points mais qu'il faut les associer à une classe d'entité et les enregister... ceq qui se fait avec les featureclass, featurelayer etc ...
Code:
Attribute VB_Name = "creapoints"
'*************************************************************************
'* Cette procédure créé les points correspondant au coordonnées X et Y *
'* qui lui sont passé. Ces points sont créés dans la première couche *
'* du bloc de données *
'*************************************************************************
Public Sub CreatePoint(x As Double, y As Double)
'On ne créé pas les points non renseignés dans la base de données
If x = 0 And y = 0 Then
Exit Sub
End If
Dim pMap As IMap
Dim pMxdoc As IMxDocument
Set pMxdoc = ThisDocument
Set pMap = pMxdoc.FocusMap
'Réccupère la première couche du bloc de données
Dim pFeatLyr As IGeoFeatureLayer
Set pFeatLyr = pMap.layer(0)
'Création des points
Dim tmpPoint As IPoint
Set tmpPoint = New Point
tmpPoint.PutCoords x, y
'Réccupère la classe d'entité (FeatureClass)
Dim pFclass As IFeatureClass
Set pFclass = pFeatLyr.FeatureClass
'Création de la nouvelle entité point
Dim pfeat As IFeature
Set pfeat = pFclass.CreateFeature
Set pfeat.Shape = tmpPoint
'Enregistrement du point dans la classe d'entité
pfeat.Store
'Destruction des références affectées aux variables
Set pfeat = Nothing
Set pFclass = Nothing
Set tmpPoint = Nothing
Set pFeatLyr = Nothing
Set pMap = Nothing
Set pMxdoc = Nothing
End Suben espérant que cela vous aide
cordialement
Julien R.
Hors ligne


