グラフィックからすべてのジオメトリを取得

 2016/9/1 (木)    

Sub test()
Dim pMxDocument As IMxDocument
Set pMxDocument = ThisDocument
 
Dim pGraphicsContainer As IGraphicsContainer
Set pGraphicsContainer = pMxDocument.FocusMap
 
Dim pEnumGeometry as IEnumGeometry
set pEnumGeometry = GetGraphicElements(pGraphicsContainer)
 
End Sub
 
 
 
'グラフィックからすべてのジオメトリを取得
Private Function GetGraphicElements(GraphicsContainer As IGraphicsContainer) As IEnumGeometry
    GraphicsContainer.Reset
     
    Dim pElement As IElement
    Set pElement = GraphicsContainer.Next
     
    Dim pGeometryCollection As IGeometryCollection
    Set pGeometryCollection = New GeometryBag
     
    Do Until pElement Is Nothing
         
        pGeometryCollection.AddGeometry pElement.Geometry
         
        Set pElement = GraphicsContainer.Next
     
    Loop
     
    Set GetGraphicElements = pGeometryCollection
 
End Function

Copyright© WINGFIELD since1981 , 2018 All Rights Reserved.