nav[aria-label="Primary Navigation"] { padding: 0; & ul { list-style: none; width: 100%; display: flex; flex-direction: row; justify-content: start; align-items: start; gap: 30px; padding: 0; & li { margin: 0; } & ul li { list-style: none; } } }

Set the extent to features on the table of content then export it to jpeg/gif

OsmanSABAN

Hi all,

I want to export a multiple feature layer by zoom into it then export it as jpeg/gif file then loop through all feature listed on the table of contents. I need to select the feature then zoom into its extent and then export it as jpeg/gif but all the the feature are NTS sheets so all the other features has to be unselected when exporting one of them as jpeg/gif. And then unselect the one just exported then move to next one, select, zoom, export, unselect, etc for rest of the list.

I found below code online from http://www.cartotalk.com. what it does is that select each record in polygon attribute table, zoom to the extent of that polygon, then export the layout to a jpeg at whatever res you want. Then it moves on the next one.

I dont want to zoom into each features attribute table, I want to zoom into whole feature itself extent.

Please help me about this,

Thank you.

Option Explicit
Private m_pMxDoc As IMxDocument
Private m_pPageLayout As IPageLayout
Private m_pGContainer As IGraphicsContainer

Private Sub AddElement(AnElement As IElement, PagePosition As IGeometry)
    Set m_pMxDoc = ThisDocument
    Set m_pPageLayout = m_pMxDoc.PageLayout
    AnElement.geometry = PagePosition
    Set m_pGContainer = m_pPageLayout
    m_pGContainer.AddElement AnElement, 0
    m_pMxDoc.ActiveView.Refresh

End Sub

Public Sub DeleteElement(AnElement As IElement, PagePosition As IGeometry)
    Set m_pMxDoc = ThisDocument
    Set m_pPageLayout = m_pMxDoc.PageLayout
    AnElement.geometry = PagePosition
    Set m_pGContainer = m_pPageLayout
    m_pGContainer.DeleteElement AnElement
    m_pMxDoc.ActiveView.Refresh

End Sub

Public Sub ExportLayout(Format As String, FileName As String, dpi As Integer)

    Dim pMxDoc As IMxDocument
    Set pMxDoc = ThisDocument

    Dim pLayout As IActiveView
    Set pLayout = pMxDoc.PageLayout

    Dim rectOut As tagRECT
    rectOut = pLayout.exportFrame

    Dim pEnv As IEnvelope
    Set pEnv = New envelope
    pEnv.PutCoords rectOut.Left, rectOut.Top, rectOut.Right, rectOut.bottom

    Dim pExporter As IExporter
    If Format = "GIF" Then
        Set pExporter = New JpegExporter
    Else
        Set pExporter = New PDFExporter
    End If

    pExporter.ExportFileName = FileName
    pExporter.PixelBounds = pEnv
    pExporter.Resolution = dpi
    'Recalc the export frame to handle the increased number of pixels
    Set pEnv = pExporter.PixelBounds

    Dim xMin As Double, yMin As Double
    Dim xMax As Double, yMax As Double
    pEnv.QueryCoords xMin, yMin, xMax, yMax

    rectOut.Left = xMin
    rectOut.Top = yMin
    rectOut.Right = xMax
    rectOut.bottom = yMax

    'Do the export
    Dim hdc As Long
    hdc = pExporter.StartExporting

    pLayout.Output hdc, dpi, rectOut, Nothing, Nothing
    pExporter.FinishExporting

    'MsgBox "Export complete!", vbInformation

End Sub

Public Sub PanZoomTitleExportWatersheds()

    Dim pMxDoc As IMxDocument
    Set pMxDoc = ThisDocument

    Dim strImageName As String

    Dim pMap As IMap
    Set pMap = pMxDoc.FocusMap

    Dim pPageLayout As IPageLayout
    Set pPageLayout = pMxDoc.PageLayout

    Dim pActiveView As IActiveView

    Set pActiveView = pMxDoc.FocusMap   ' Set to FocusMap, allows zoom to work in page layout or data view

    Dim pFeatureLayer As IFeatureLayer
    Set pFeatureLayer = pMap.layer(0)   ' First layer in map

    Dim pFeatureClass As IFeatureClass
    Set pFeatureClass = pFeatureLayer.featureClass

    Dim pFeatureCursor As IFeatureCursor
    Set pFeatureCursor = pFeatureClass.Search(Nothing, False)   ' Set QF to Nothing, get all features

    Dim pFeature As IFeature
    Dim Counter As Integer
    Dim pEnvelope As IEnvelope
    Dim pLayer As IFeatureLayer

    Set pFeature = pFeatureCursor.NextFeature ' clear it, get the first feature

    Do Until pFeature Is Nothing
        Counter = Counter + 1

        ' Create image file name from attributes
        strImageName = ReplaceMultiple(pFeature.Value(5), "_", " ", ",", "-", ".") & "_" & pFeature.Value(9) 'ReplaceMultiple gets rid of spaces/special characters in names
        ' Zoom
        pActiveView.Extent = pFeature.Shape.envelope
        ' Set the extent to that of the active view
        Set pEnvelope = pActiveView.Extent
            ' Expand out a little bit
            If (pFeature.Shape.envelope.width / pFeature.Shape.envelope.height) < 0.3 Then
                pEnvelope.Expand 2, 2, True
            Else
                pEnvelope.Expand 1.25, 1.25, True
            End If
        ' Center
        pActiveView.Extent = pEnvelope
        ' Refresh after zoom
        pActiveView.Refresh
        'MsgBox strImageName
        ' Call ExportLayout, export the current layout
        ExportLayout "GIF", "C:\Users\osaban\Desktop\Datasets-In Process\Canada Land Inventory (150 000) - Land Capability for Agriculture\Alberta\" & strImageName & ".gif", 175
        ' Refresh after deletion
        pActiveView.Refresh
        ' Go to next
        Set pFeature = pFeatureCursor.NextFeature
    Loop

End Sub

Public Function ReplaceMultiple(ByVal OrigString As String, _
     ByVal ReplaceString As String, ParamArray FindChars()) _
     As String

    '*********************************************************
    'PURPOSE: Replaces multiple substrings in a string with the
    'character or string specified by ReplaceString

    'PARAMETERS: OrigString -- The string to replace characters in
    '            ReplaceString -- The replacement string
    '            FindChars -- comma-delimited list of
    '                 strings to replace with ReplaceString
    '
    'RETURNS:    The String with all instances of all the strings
    '            in FindChars replaced with Replace String
    'EXAMPLE:    s= ReplaceMultiple("H;*()ello", "", ";", ",", "*", "(", ")") -
                 'Returns Hello
    'CAUTIONS:   'Overlap Between Characters in ReplaceString and
    '             FindChars Will cause this function to behave
    '             incorrectly unless you are careful about the
    '             order of strings in FindChars
    '***************************************************************

    Dim lLBound As Long
    Dim lUBound As Long
    Dim lCtr As Long
    Dim sAns As String

    lLBound = LBound(FindChars)
    lUBound = UBound(FindChars)

    sAns = OrigString

    For lCtr = lLBound To lUBound
        sAns = Replace(sAns, CStr(FindChars(lCtr)), ReplaceString)
    Next

    ReplaceMultiple = sAns


End Function

Public Function MakeGifFileName(strHucName As String, strHucNumber As String) As String

    If Trim(strHucName) = "" Then
        MakeGifFileName = Trim(strHucNumber)
    Else
        MakeGifFileName = Trim(strHucNumber) & "_" & ReplaceMultiple(ReplaceMultiple(strHucName, "_", " ", "-"), "", "'", ".", ",")
    End If

End Function

Finde mehr Beiträge mit dem Tag

Accepted answers

kenbuja

You'd just have to comment out where it checks if the layer is a Feature Layer

Do While Not (pLayer Is Nothing)   'If TypeOf pLayer Is IFeatureLayer Then   pLayer.Visible = True   pActiveView.extent = pLayer.AreaOfInterest   pActiveView.Refresh   ExportLayout "GIF", "C:\Users\Desktop\" & pLayer.Name & ".gif", 175   'System.Windows.Forms.MessageBox.Show (pLayer.Name)                        pLayer.Visible = False   'End If                    Set pLayer = pEnumLayer.Next Loop

Don't forget to mark the answer as correct and/or helpful

All comments

MLowry

Any reason you're not using Python for this workflow?

OsmanSABAN

i dont have any reason to use python. That's what I found for what I needed. do you have any suggestions?

please help

Thanks

OsmanSABAN

Hi all,

Please help me about this

Thank you

kenbuja

Which version of ArcGIS are you using?

OsmanSABAN

Which version of ArcGIS are you using?

I am using ArcGIS 10.

kenbuja

I'm having difficulty in trying to understand your goals. Can you provide an illustration of what you're trying to achieve?

OsmanSABAN

I am sending some images to clear things little bit.

In image NTS Sheet, that is what I have as dataset in the data frame window, each of of them is a different shape file adjacent to each other. I want to go through table of content layers then zoom into first one and export it as jpg or gif while the adjacent nts sheets are turned off.

The final product should look like 083H120_1, not like as in 083H120.

I hope this helps to clear it out.

Thank you

Here is some code written in VB.NET ( so you'll have to do some slight modifications for VBA) that will loop through the table of contents three times. The code first gets the original extent of the activeview. The first loop will turn off all the layers. The second loop will turn on a layer and zoom to its extent, pops up a message box to pause the operation, then turns the layer off. The third loop turns the layers back on once again. Finally, the activeview is set back to the original extent.

            Dim activeView As ESRI.ArcGIS.Carto.IActiveView
            activeView = pMxDoc.ActiveView

            Dim extent As ESRI.ArcGIS.Geometry.IEnvelope
            extent = activeView.Extent

            Dim pMap As ESRI.ArcGIS.Carto.IMap
            pMap = pMxDoc.FocusMap

            Dim enumLayer As ESRI.ArcGIS.Carto.IEnumLayer
            enumLayer = pMap.Layers
            enumLayer.Reset()

            Dim layer As ESRI.ArcGIS.Carto.ILayer
            layer = enumLayer.Next

            Do While Not (layer Is Nothing)
                layer.Visible = False
                layer = enumLayer.Next
            Loop

            enumLayer.Reset()
            layer = enumLayer.Next
            Do While Not (layer Is Nothing)
                If TypeOf layer Is ESRI.ArcGIS.Carto.IFeatureLayer Then
                    layer.Visible = True
                    activeView.Extent = layer.AreaOfInterest
                    activeView.Refresh()
                    System.Windows.Forms.MessageBox.Show(layer.Name)
                    layer.Visible = False
                End If
                layer = enumLayer.Next
            Loop

            enumLayer.Reset()
            layer = enumLayer.Next
            Do While Not (layer Is Nothing)
                layer.Visible = True
                layer = enumLayer.Next
            Loop
            activeView.Extent = extent
            activeView.Refresh()

OsmanSABAN

Thank you Ken, I dont know how to integrate this into VBA but i will try it out.

kenbuja

Most of it will go over directly. You'll have to add in "Set" to some of the statements and you won't need the fully qualified declarations (Dim activeView As IActiveView instead of Dim activeView As ESRI.ArcGIS.Carto.IActiveView, for example).

OsmanSABAN

Thank you again Ken,

I made some changes you mentioned and add some Public sub to setup the path to save the gif files and it works perfectly.

Now, another thing is that how can I do the same thing for spatial image files?

Any help?

Thank you

Private Sub ExportToGIF()

            Dim pActiveView As IActiveView
            Dim pRaster As IRaster

            Dim pMxDoc As IMxDocument
            Set pMxDoc = ThisDocument

            Dim pMap As IMap
            Set pMap = pMxDoc.FocusMap

            Set pActiveView = pMxDoc.activeView

            Dim pExtent As IEnvelope
            Set pExtent = pActiveView.extent

            Dim pEnumLayer As IEnumLayer
            Set pEnumLayer = pMap.Layers
            pEnumLayer.Reset

            Dim pLayer As ILayer
            Set pLayer = pEnumLayer.Next

            Do While Not (pLayer Is Nothing)
                pLayer.Visible = False
                Set pLayer = pEnumLayer.Next
            Loop

            pEnumLayer.Reset
            Set pLayer = pEnumLayer.Next
            Do While Not (pLayer Is Nothing)
                If TypeOf pLayer Is IFeatureLayer Then
                    pLayer.Visible = True
                    pActiveView.extent = pLayer.AreaOfInterest
                    pActiveView.Refresh
                    ExportLayout "GIF", "C:\Users\Desktop\" & pLayer.Name & ".gif", 175
                    'System.Windows.Forms.MessageBox.Show (pLayer.Name)

                    pLayer.Visible = False
                End If

                Set pLayer = pEnumLayer.Next
            Loop

            pEnumLayer.Reset
            Set pLayer = pEnumLayer.Next
            Do While Not (pLayer Is Nothing)
                pLayer.Visible = True
                Set pLayer = pEnumLayer.Next
            Loop
            Set pExtent = pActiveView.extent '= pExtent
            pActiveView.Refresh
End Sub

Public Sub ExportLayout(Format As String, FileName As String, dpi As Integer)

    Dim pMxDoc As IMxDocument
    Set pMxDoc = ThisDocument

    Dim pLayout As IActiveView
    Set pLayout = pMxDoc.PageLayout

    Dim rectOut As tagRECT
    rectOut = pLayout.ExportFrame

    Dim pEnv As IEnvelope
    Set pEnv = New Envelope
    pEnv.PutCoords rectOut.Left, rectOut.Top, rectOut.Right, rectOut.bottom

    Dim pExporter As IExporter
    If Format = "GIF" Then
        Set pExporter = New JpegExporter
    Else
        Set pExporter = New PDFExporter
    End If

    pExporter.ExportFileName = FileName
    pExporter.PixelBounds = pEnv
    pExporter.Resolution = dpi
    'Recalc the export frame to handle the increased number of pixels
    Set pEnv = pExporter.PixelBounds

    Dim xMin As Double, yMin As Double
    Dim xMax As Double, yMax As Double
    pEnv.QueryCoords xMin, yMin, xMax, yMax

    rectOut.Left = xMin
    rectOut.Top = yMin
    rectOut.Right = xMax
    rectOut.bottom = yMax

    'Do the export
    Dim hDC As Long
    hDC = pExporter.StartExporting

    pLayout.Output hDC, dpi, rectOut, Nothing, Nothing
    pExporter.FinishExporting

    'MsgBox "Export complete!", vbInformation

End Sub

kenbuja

You'd just have to comment out where it checks if the layer is a Feature Layer

Do While Not (pLayer Is Nothing)   'If TypeOf pLayer Is IFeatureLayer Then   pLayer.Visible = True   pActiveView.extent = pLayer.AreaOfInterest   pActiveView.Refresh   ExportLayout "GIF", "C:\Users\Desktop\" & pLayer.Name & ".gif", 175   'System.Windows.Forms.MessageBox.Show (pLayer.Name)                        pLayer.Visible = False   'End If                    Set pLayer = pEnumLayer.Next Loop

Don't forget to mark the answer as correct and/or helpful

OsmanSABAN

Thank you Ken, I did mark it.

I am really appreciated with your help a lot.

Thank you again

Nimm an der Diskussion teil

Angemeldete Mitglieder können Beiträge verfassen, Updates folgen und mehr. Neu hier? Registriere ein kostenloses Konto.

Schnellzugriffe

Community Help
Find useful guides, FAQs, and documents to help you navigate and make the most of Esri Community.