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é ?

#1 Tue 01 February 2005 22:05

Claire Combeau
Invité

Zoom a la meme echelle entre deux blocs de donnees

De: Claire Combeau
Bonjour,

J'ai dans ma mise en page deux cartes issues de deux blocs de donnees representants deux entites identiques avec des analyses thematiques differentes.

Lorsque je zoom sur l'une des cartes, je souhaite que la deuxieme se cale automatiquement au meme niveau de zoom. J'ai utilise les geosignets dans le mode donnees ce qui fonctionne bien mais y a -til un autre outil ou une manip pour recaler de facon similaire en mode mise en page ?

Merci

Claire COMBEAU
Conservatoire regional des rives de la Loire

 

#2 Tue 01 February 2005 22:05

TOUYAA Franck
Invité

Re: Zoom a la meme echelle entre deux blocs de donnees

Bonjour,

Voici un script que j'ai trouve en surfant sur le support ESRI USA et qui peut repondre a votre demande.
Ce script permet de zoomer et de se mettre a la meme echelle.
En esperant avoir repondu a votre question

Cordialement,

Franck TOUYAA
Cartographe- Geomaticien
Direction de l'Urbanisme Operationnel
www.nanterre.fr

Code:

'Select Tools / Customize
'Select the Commands Tab
'From the categories list (left) select UIControls
'Click on button New UIControl...
'Select UIButtonControl and click on button Create and Edit
'Paste the code below between lines Private Sub UIButtonControl1_Click() and End Sub
'Close the VBA Editor
'Select Tools / Customize
'Select the Commands Tab

'From the categories list (left) select UIControls
'From the commands list (right) select Normal.UIButtonControl1
'Drag the buttoncontrol to a toolbar (such as the Tools toolbar where the zoom and pan tools are)
'Right click on the buttoncontrol that was dragged to the toolbar and change the description and button image to something understandable
'Close the customize window

'In case that you have only 1 dataframe you will receive a message that you dont have enough dataframes
'In case you have only 2 dataframes the none active dataframe will receive the extent from the active dataframe (note that if the size and perhaps orientation of the dataframes differ, the extent will not be the same)
'In case you have more than 2 dataframes a list dialog is shown where you can select the dataframe that should be addapted. Select  in case you want to change th extent of all the dataframe to the active dataframe

Dim pMxDoc As IMxDocument
Set pMxDoc = ThisDocument
Dim pMaps As IMaps
Set pMaps = pMxDoc.Maps

'check if tool should work:
Dim intMapsCount As Integer
If pMaps.Count = 1 Then
  MsgBox There is only 1 dataframe available, tool will not have any effect...
  Exit Sub
Else
  intMapsCount = pMaps.Count
End If

'read the extent of focusmap
Dim pFocusMap As IMap
Set pFocusMap = pMxDoc.FocusMap
Dim pActiveView As IActiveView
Set pActiveView = pFocusMap
Dim pEnvFocusMap As IEnvelope
Set pEnvFocusMap = pActiveView.Extent

Dim pMap As IMap
Dim i As Integer

If intMapsCount = 2 Then
  If pMaps.Item(0) Is pFocusMap Then 
    Set pMap = pMaps.Item(1)
  Else
    Set pMap = pMaps.Item(0)
  End If
  Set pActiveView = pMap
  pActiveView.Extent = pEnvFocusMap
Else
  'offer a list where the user can select the dataframe that should be addapted
  Dim pListDlg As IListDialog
  Dim boolOK As Boolean
  Dim strChoice As String
  Dim pCurrentMap As IMap
  Set pListDlg = New ListDialog

  For i = 0 To intMapsCount - 1
    Set pCurrentMap = pMaps.Item(i)
    If pCurrentMap Is pFocusMap Then
      strChoice = i &  -  & pCurrentMap.Name &  (Active mapframe)
    Else
      strChoice = i &  -  & pCurrentMap.Name
    End If
    pListDlg.AddString strChoice
  Next i

  pListDlg.AddString
  boolOK = pListDlg.DoModal( Select Dataframe to be adapted , 0, Application.hWnd)
  If boolOK Then
    If pListDlg.Choice = intMapsCount Then
      'all dataframe
      For i = 0 To intMapsCount - 1
        Set pMap = pMaps.Item(i)
        Set pActiveView = pMap
        pActiveView.Extent = pEnvFocusMap
      Next i
    Else
      Set pMap = pMaps.Item(pListDlg.Choice)
      Set pActiveView = pMap
      pActiveView.Extent = pEnvFocusMap
    End If
  Else
    MsgBox No selection was made...
    Exit Sub
  End If
End If

'refresh
pMxDoc.ActiveView.Refresh
 

Pied de page des forums

Powered by FluxBB