如果把一个图层ILayer数据COPY到三维Scenecontrol控件中（进行相关操作）

内容摘要

把Mapcontrol中的数据或一个ILayer图层的数据或一个选择集的数据COPY到Scenecontrol三维控件中来。

过程描述

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