Redirect Multiple Batch Lyr Layerfiles in ArcCatalog

RW — Fri, 24 Sep 2010 10:30:04 GMT

Hi

We have hundreds of folders and inside the folders there is 1 mxd and approx 6 shapefiles and 6 layerfiles. Unfortunately the layerfiles have been created from a geodatabase and so are 'looking' at the wrong data source - so do not work.

We have some code that basically works by selecting an mxd in catalog - it runs through the toc and saves out the layer files to a selected folder (in essence replacing or overwriting any existing lyrs). The process works to a point - the layerfiles are created but when you click on preview they need redirected! Any ideas how to fix this or any other ways we should go about batch redirection? (We want to avoid having to open every mxd if possible) Frm Code is below:

VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} CreateLayerFiles
   Caption         =   "Create Layer Files from selected MXDs"
   ClientHeight    =   1020
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   5340
   OleObjectBlob   =   "CreateLayerFiles.frx":0000
   StartUpPosition =   1 'CenterOwner
End
Attribute VB_Name = "CreateLayerFiles"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit
Private Declare Function GetDesktopWindow Lib "user32" () As Long

Private Sub Browse_Click()
Me.outputDir = GetPathFromDialog("Folder for output layer files")
End Sub

Private Sub Cancel_Click()
Unload Me
End Sub

Private Sub Ok_Click()
Dim outDir As String
outDir = Me.outputDir
'
' Get filesystem object
'
Dim pFSO As Scripting.fileSystemObject
Set pFSO = New Scripting.fileSystemObject
'
' Check folder exists
'
If (Not pFSO.FolderExists(outDir)) Then
    pFSO.CreateFolder (outDir)
End If

Call DoMXDs(outDir)

Unload Me
End Sub

Sub DoMXDs(outDir As String)
'
' Get application
'
Dim pGxApp As IGxApplication
Set pGxApp = Application
'
' Get list of selected objects
'
Dim pEnumGxObj As IEnumGxObject
Set pEnumGxObj = pGxApp.Catalog.Selection.SelectedObjects
If (pGxApp.Catalog.Selection.Count = 0) Then Exit Sub
'
' Loop through each selected mxd (ignore an other selected objects)
'
Dim pGxObject As IGxObject
Set pGxObject = pEnumGxObj.Next
Do Until pGxObject Is Nothing
    If (TypeOf pGxObject Is IGxMap) Then
      Call CreateLyr(pGxObject.FullName, outDir)
      Application.StatusBar.Message(0) = "Finished modifying " & pGxObject.FullName
    End If

    Set pGxObject = pEnumGxObj.Next
Loop

End Sub

Sub CreateLyr(mxdPath As String, outDir As String)
Dim pMapDocument As IMapDocument
Set pMapDocument = New MapDocument
pMapDocument.Open mxdPath
Dim pActiveView As IActiveView
Set pActiveView = pMapDocument.PageLayout
'pActiveView.Activate GetDesktopWindow()
pActiveView.Activate Application.hWnd
'
' Loop through each map in mxd
'
Dim i As Long, pMap As IMap
For i = 0 To pMapDocument.MapCount - 1
    Set pMap = pMapDocument.Map(i)
    '
    ' Loop through each layer and save to lyr file
    '
    Dim pLayers As IEnumLayer
    Set pLayers = pMap.Layers(Nothing, True)
    Dim pLayer As ILayer
    Set pLayer = pLayers.Next
    Do Until pLayer Is Nothing
      Call StoreRelativeBase(pLayer, outDir)
      Set pLayer = pLayers.Next
    Loop
Next i

End Sub

Function GetPathFromDialog(theTitle As String) As String
'
' Name: GetPathFromDialog
' Purpose: To Get workspace path from user via a dialog
' Written: K.Adlam
'
Dim pGxDialog As IGxDialog
Set pGxDialog = New GxDialog
pGxDialog.AllowMultiSelect = False
pGxDialog.Title = theTitle
'pGxDialog.StartingLocation = "Database Connections"
'
'Set up filter to restrict data type shown to layers
'
Dim pGxFilter As IGxObjectFilter
'Set pGxFilter = New GxFilterLayers
Set pGxFilter = New GxFilterContainers
Set pGxDialog.ObjectFilter = pGxFilter
'
' Open Dialog
'
Dim pEnumGxObj As IEnumGxObject
If Not pGxDialog.DoModalOpen(0, pEnumGxObj) Then
'If Not pGxDialog.DoModalSave(0) Then
GetPathFromDialog = ""
    Exit Function
End If
'
' Loop through selected objects and add to current map
'
Dim pGxObj As IGxObject
pEnumGxObj.Reset
Set pGxObj = pEnumGxObj.Next
GetPathFromDialog = pGxObj.FullName

End Function

Public Sub StoreRelativeBase(inLayer As ILayer, inRelBase As String)
If (TypeOf inLayer Is IDataLayer2) Then
    Dim pDataLayer As IDataLayer2
    Set pDataLayer = inLayer
    pDataLayer.RelativeBase = inRelBase
    Dim pGxLayer As IGxLayer
    Dim pGxFile As IGxFile

    Set pGxLayer = New GxLayer
    Set pGxFile = pGxLayer
    pGxFile.path = inRelBase & "\" & inLayer.Name & ".lyr"
    Set pGxLayer.Layer = inLayer
End If
End Sub

Private Sub UserForm_Click()

End Sub

topic Redirect Multiple Batch Lyr Layerfiles in ArcCatalog in ArcObjects SDK Questions

Redirect Multiple Batch Lyr Layerfiles in ArcCatalog