backupelement.txt

一个不错的插件

Sub SaveElements()
  Dim pDoc As IMxDocument, pPage As IPageLayout
  Dim pGraphicsCont As IGraphicsContainer, pElem As IElement
  Dim pMapFrame As IMapFrame, pTrans As ITransform2D
  Dim pActive As IActiveView, lLoop As Long
  Set pDoc = ThisDocument
  Set pPage = pDoc.PageLayout
  Set pGraphicsCont = pPage
  pGraphicsCont.Reset
  Set m_pCollection = New Collection
  Set pElem = pGraphicsCont.Next
  'loop through collection the elements
  Do While Not pElem Is Nothing
    If TypeOf pElem Is IMapFrame Then
      Set pTrans = pElem
      pTrans.Move -100, -100
      pGraphicsCont.UpdateElement pElem
    Else
      m_pCollection.Add pElem
'      pGraphicsCont.DeleteElement pElem
    End If
    
    Set pElem = pGraphicsCont.Next
  Loop
  
  'Loop through the collection and delete the elements
  For lLoop = 1 To m_pCollection.Count
    pGraphicsCont.DeleteElement m_pCollection.Item(lLoop)
  Next lLoop
  
  Set pActive = pPage
  pActive.Refresh
End Sub

Sub RestoreElements()
  Dim pDoc As IMxDocument, pPage As IPageLayout, pTrans As ITransform2D
  Dim pGraphicsCont As IGraphicsContainer, pElem As IElement
  Dim pMapFrame As IMapFrame, lLoop As Long, pActive As IActiveView
  Dim pEnum As IEnumElement, pGraphicsSel As IGraphicsContainerSelect
  Set pDoc = ThisDocument
  Set pPage = pDoc.PageLayout
  
  Set pGraphicsCont = pPage
  For lLoop = m_pCollection.Count To 1 Step -1
    pGraphicsCont.AddElement m_pCollection.Item(lLoop), 0
  Next lLoop
  
  Set pGraphicsSel = pGraphicsCont
  pGraphicsSel.UnselectAllElements
  
  pGraphicsCont.Reset
  Set pElem = pGraphicsCont.Next
  Do While Not pElem Is Nothing
    If TypeOf pElem Is IMapFrame Then
      Set pTrans = pElem
      pTrans.Move 100, 100
      pGraphicsCont.UpdateElement pElem
      pGraphicsSel.SelectElement pElem
      pGraphicsCont.BringToFront pGraphicsSel.SelectedElements
      pGraphicsSel.UnselectAllElements
    End If
    
    Set pElem = pGraphicsCont.Next
  Loop
  
  Set pActive = pPage
  pActive.Refresh
End Sub