I have an ArcObjects VBA code that exports a series of group layers listed in a table (also listed in the table of contents) to pdf. For each group layer/export the legend also changes to represent the specific group layer that is exporting out. When I added the legend refresh portion of the code each group layer export took about 10X slower to export (before it took about 3-4 sec to export each group layer, now it takes well over 40 sec). I'm curious if anybody has any suggestions on how I may change the code around to increase the speed again. Here is the code.
'Export to pdfs
Dim pFSO2 As FileSystemObject
Dim pNewFolderc As folder
Set pFSO2 = New FileSystemObject
If (pFSO2.FolderExists("C:\TMP") = False) Then
Set pNewFolderc = pFSO2.CreateFolder("C:\TMP")
Else
Set pNewFolderc = pFSO2.GetFolder("C:\TMP")
End If
Dim pAV As IActiveView
Dim pPageLayout As IPageLayout
Dim pEnum As IEnumLayer
Dim pLayer As ILayer
Dim pGLayer As IGroupLayer
Dim pFLayer As IFeatureLayer
Dim pFClass As IFeatureClass
Dim pGxLayer As IGxLayer, pGxNewLayer As IGxLayer, pGxFile As IGxFile
Dim pGrpLayer As IGroupLayer
Dim pStdTableColl As IStandaloneTableCollection
Dim pStdTable As IStandaloneTable
Dim pTable As ITable
Dim pTableSort As ITableSort
Dim pTblSortLyrs As ITableSort
Dim pRow As IRow
Dim pRowLyrs As IRow
Dim pDataStat As IDataStatistics
Dim pCursor As ICursor
Dim pLyrCursor As ICursor
Dim pQf As IQueryFilter
Dim lngFldLayerName As Long
Dim lngFldPath As Long
Dim lngFldGroupOrder As Long
Dim lngFldGroupName As Long
Dim lngFldGroupTOCOrder As Long
Dim lngFldGroupVis As Long
Dim i As Integer
Dim strLayerName As String
Dim strPath As String
Dim lngGroupOrder As Long
Dim strGroupName As String
Dim lngGroupTOCOrder As Long
Dim blnGroupVis As Boolean
Dim pEnumVar As IEnumVariantSimple, value As Variant
Dim pODGSLyr As ODGSLayer
Dim pGrphcon As IGraphicsContainer
Dim pElem As IElement
Dim pTxtElem As ITextElement
strOMSIUAComplaintNo = txtfoldername.Text
If cboAPPNO.Text = "" Or txtfoldername.Text = "" Then
MsgBox "Please select APPNO well feature"
Exit Sub
Else
Dim intresponse2 As Integer
intresponse2 = MsgBox("Export pdfs?", vbYesNo)
If intresponse2 = vbNo Then
UserForm1.Hide
cboAPPNO.Text = ""
txtfoldername = ""
Exit Sub
ElseIf intresponse2 = vbYes Then
UserForm1.Caption = "Exporting, please wait..."
'Goto Page layout
Set pPageLayout = m_pMxDoc.PageLayout
Set m_pMxDoc.ActiveView = pPageLayout
'Find Basemap Group and DRG layers and turn both of them on
Set m_pMap = m_pMxDoc.FocusMap
Set pEnum = m_pMap.Layers
Set pLayer = pEnum.Next
Do Until pLayer Is Nothing
If pLayer.Name = "Basemaps" Then pLayer.Visible = True
If pLayer.Name Like "DRG*" Then pLayer.Visible = True
Set pLayer = pEnum.Next
Loop
'Turn off all the group layers
Set pStdTableColl = m_pMap
For i = 0 To pStdTableColl.StandaloneTableCount - 1
Set pStdTable = pStdTableColl.StandaloneTable(i)
If pStdTable.Name = "ODGSLAYERS" Then
Set pTable = pStdTable
lngFldLayerName = pTable.FindField("LAYERNAME")
lngFldPath = pTable.FindField("PATH")
lngFldGroupOrder = pTable.FindField("GROUPORDER")
lngFldGroupName = pTable.FindField("GROUPNAME")
lngFldGroupTOCOrder = pTable.FindField("GROUPTOCORDER")
lngFldGroupVis = pTable.FindField("GROUPVISABLE")
End If
Next i
If pStdTable Is Nothing Then
Exit Sub
End If
'Sort the Table
Set pTableSort = New TableSort
With pTableSort
.Fields = "GROUPTOCORDER, GROUPNAME"
.Ascending("GROUPTOCORDER") = True
.Ascending("GROUPNAME") = True
Set .QueryFilter = Nothing
Set .Table = pTable
End With
pTableSort.Sort Nothing
Set pCursor = pTableSort.Rows
'Find Unique Values in the Table
Set pDataStat = New DataStatistics
pDataStat.field = "GROUPNAME"
Set pDataStat.Cursor = pCursor
Set pEnumVar = pDataStat.UniqueValues
value = pEnumVar.Next
Do Until IsEmpty(value)
pEnum.Reset
Set pLayer = pEnum.Next
Do Until pLayer Is Nothing
If pLayer.Name = value Then pLayer.Visible = False
Set pLayer = pEnum.Next
Loop
strLayerName = value
value = pEnumVar.Next
Loop
'Now cycle through the group layers, turn them on one by one and export the PDF file
'First find the Title on the map
Set pGrphcon = pPageLayout
pGrphcon.Reset
Set pElem = pGrphcon.Next
Do Until pElem Is Nothing
If TypeOf pElem Is ITextElement Then
Set pTxtElem = pElem
If pTxtElem.Text = "OMSIUA Layers" Then Exit Do
End If
Set pElem = pGrphcon.Next
Loop
Set pStdTableColl = m_pMap
For i = 0 To pStdTableColl.StandaloneTableCount - 1
Set pStdTable = pStdTableColl.StandaloneTable(i)
If pStdTable.Name = "ODGSLAYERS" Then
Set pTable = pStdTable
lngFldLayerName = pTable.FindField("LAYERNAME")
lngFldPath = pTable.FindField("PATH")
lngFldGroupOrder = pTable.FindField("GROUPORDER")
lngFldGroupName = pTable.FindField("GROUPNAME")
lngFldGroupTOCOrder = pTable.FindField("GROUPTOCORDER")
lngFldGroupVis = pTable.FindField("GROUPVISABLE")
End If
Next i
If pStdTable Is Nothing Then
Exit Sub
End If
'Sort the Table
Set pTableSort = New TableSort
With pTableSort
.Fields = "GROUPTOCORDER, GROUPNAME"
.Ascending("GROUPTOCORDER") = True
.Ascending("GROUPNAME") = True
Set .QueryFilter = Nothing
Set .Table = pTable
End With
pTableSort.Sort Nothing
Set pCursor = pTableSort.Rows
'Find Unique Values in the Table
Set pDataStat = New DataStatistics
pDataStat.field = "GROUPNAME"
Set pDataStat.Cursor = pCursor
Set pEnumVar = pDataStat.UniqueValues
value = pEnumVar.Next
Do Until IsEmpty(value)
pEnum.Reset
Set pLayer = pEnum.Next
Do Until pLayer Is Nothing
If pLayer.Name = value Then
pLayer.Visible = True
strLayerName = value
pTxtElem.Text = strLayerName
''''''''''''Cal to ExportActiveView, Module''''''''''''''''
Call ExportActiveView.ExportActiveView(strOMSIUAComplaintNo & "_" & _ strLayerName)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
pLayer.Visible = False
End If
'Refresh legend '<<<<<<<<<<<<< Refresh legend portion
Dim pMxDoc2 As IMxDocument
Dim pPageLayout2 As IPageLayout
Dim pGC2 As IGraphicsContainer
Dim pElem2 As IElement
Dim pMSF2 As IMapSurroundFrame
Dim pMS2 As IMapSurround
Set pMxDoc2 = ThisDocument
Set pPageLayout2 = pMxDoc2.PageLayout
Set pGC2 = pPageLayout2
pGC2.Reset
Set pElem2 = pGC2.Next
Do Until pElem2 Is Nothing
If TypeOf pElem2 Is IMapSurroundFrame Then
Set pMSF2 = pElem2
Set pMS2 = pMSF2.MapSurround
pMS2.Refresh
pMxDoc2.ActiveView.Refresh
End If
Set pElem2 = pGC2.Next
Loop
Set pLayer = pEnum.Next
Loop
value = pEnumVar.Next
Loop
pTxtElem.Text = "OMSIUA Layers"
Set m_pMxDoc.ActiveView = m_pMap
m_pMxDoc.UpdateContents
m_pMxDoc.ActiveView.Refresh
End If
End If
