|
Dim pfeatureselection As IFeatureSelection
Dim pSpatialFilter As ISpatialFilter
Dim pFeatureLayerDefinition As IFeatureLayerDefinition
Dim pFeatureLayerMx As IFeatureLayer
Dim pFeatureLayerSx As IFeatureLayer
Dim p3DProperties As I3DProperties
Dim pGeoFeatureLayerMx As IGeoFeatureLayer
Dim pGeoFeatureLayerSx As IGeoFeatureLayer
Dim pLayerSx As ILayer
Dim pColor As IColor
Dim pSymbol As ISymbol
Dim pObjectCopy As IObjectCopy 'esriControlsSupport.IObjectCopy
'
Dim pListItems As MSComctlLib.ListItems
Dim pListItem As MSComctlLib.ListItem
'------------------------------------------------------
' Select Features That pass through the current extent
'------------------------------------------------------
Set pLayerSx = Nothing
If TypeOf pLayerMx Is IFeatureLayer Then
Set pFeatureLayerMx = pLayerMx
If pFeatureLayerMx.FeatureClass.FeatureType = esriFTSimple Then
Set pSpatialFilter = New SpatialFilter
Set pSpatialFilter.Geometry = mEnvelope
'
' pSpatialFilter.GeometryField = pFeatureLayerMx.FeatureClass.ShapeFieldName
pSpatialFilter.SpatialRel = esriSpatialRelIntersects
'
Set pfeatureselection = pFeatureLayerMx
Call pfeatureselection.SelectFeatures(pSpatialFilter, esriSelectionResultNew, False)
'
Set pFeatureLayerDefinition = pFeatureLayerMx
Set pFeatureLayerSx = pFeatureLayerDefinition.CreateSelectionLayer(pFeatureLayerMx.Name, True, "", "")
pFeatureLayerSx.Visible = pFeatureLayerMx.Visible
'
Call pfeatureselection.Clear
'
Set pGeoFeatureLayerMx = pFeatureLayerMx
Set pGeoFeatureLayerSx = pFeatureLayerSx
Set pObjectCopy = New ObjectCopy
Set pGeoFeatureLayerSx.Renderer = pObjectCopy.Copy(pGeoFeatureLayerMx.Renderer)
'
Set pLayerSx = pFeatureLayerSx
End If
Else
If TypeOf pLayerMx Is IRasterLayer Then
Dim pRasterLayerMx As IRasterLayer
Set pRasterLayerMx = pLayerMx
pRasterLayerMx.VisibleExtent = mEnvelope
Set pLayerSx = pRasterLayerMx
End If
End If
'-----------------------
' Add Layer to ArcScene 其中mSceneGraph为控件名称
'-----------------------
Call mSceneGraph.Scene.AddLayer(pLayerSx, False)
'---------------------------------
' Update 3D Properties of SxLayer
'---------------------------------
Set p3DProperties = Get3DPropertiesFromLayer(pLayerSx)
If Not (p3DProperties Is Nothing) Then
' p3DProperties.BaseExpressionString = "0"
' p3DProperties.BaseOption = esriBaseShape
p3DProperties.DepthPriorityValue = pPriority
' p3DProperties.ExtrusionExpressionString = ""
' p3DProperties.ExtrusionType = esriExtrusionNone
' p3DProperties.FaceCulling = esriFaceCullingNone
' p3DProperties.Illuminate = True
' p3DProperties.OffsetExpressionString = "0"
' p3DProperties.RenderMode = esriRenderCache
' p3DProperties.RenderRefreshRate = 0.75
' p3DProperties.RenderVisibility = esriRenderAlways
' p3DProperties.SmoothShading = True
' p3DProperties.ZFactor = 1
'
Call p3DProperties.Apply3DProperties(pLayerSx)
End If
' End If
|
|
管理
