|
阅读：2430回复：2
ArcEngine中三维管线的表示方法
<P>我现在要用engine做管线的三维效果，利用管径的不同以不同的管状体来表示水管的大小。现在我做到这个状态的时候遇到了难题，不知道怎么将三维的风格加入管线的symbol中去。请教各位高手！希望大家帮帮忙！<IMG src="http://www.gisempire.com/bbs/Skins/Default/emot/em12.gif"></P>
<P>Dim pRen As ISimpleRenderer<BR>Dim pGeoFeatLyr As IGeoFeatureLayer</P> <P>Dim i As Integer</P> <P>For i = 0 To frmViewer3D.SceneControl1.Scene.LayerCount - 1<BR> If frmViewer3D.SceneControl1.Scene.Layer(i).Name = "给水管线" Then</P> <P> Set pGeoFeatLyr = frmViewer3D.SceneControl1.Scene.Layer(i)<BR> Set pRen = pGeoFeatLyr.Renderer<BR> <BR>' Dim pSimpleRenderer As ISimpleRenderer<BR> Dim pSimpleLineSymbol As ISimpleLine3DSymbol<BR> Set pSimpleLineSymbol = New SimpleLine3DSymbol<BR> pSimpleLineSymbol.Style = esriS3DLSTube<BR> <BR>' Set pGeoFeatLyr.ScaleSymbols = pSimpleLineSymbol<BR> <BR> Dim pStyleGal As IStyleGallery<BR> Dim pStyleStorage As IStyleGalleryStorage<BR> Dim pEnumStyleGall As IEnumStyleGalleryItem<BR> Dim pStyleItem As IStyleGalleryItem<BR> Set pStyleGal = New ServerStyleGallery<BR> <BR> Set pStyleStorage = pStyleGal</P> <P> pStyleStorage.TargetFile = App.Path ; "\3D Basic.ServerStyle"<BR> Set pEnumStyleGall = pStyleGal.Items("Line Symbols", "", "")<BR> <BR> pEnumStyleGall.Reset<BR> Set pStyleItem = pEnumStyleGall.Next<BR> Do While Not pStyleItem Is Nothing<BR> <BR> If pStyleItem.Name = "4LaneRoad" Then<BR> Dim pSym As ISymbol3D<BR> Set pSym = pStyleItem.Item<BR> <BR> <BR> GoTo ExitLOOP<BR> End If<BR> Set pStyleItem = pEnumStyleGall.Next<BR> Loop<BR>ExitLOOP:<BR> <BR> Set pRen.Symbol = pSym<BR> <BR> End If</P> <P>Next</P> <P>frmViewer3D.SceneControl1.Scene.SceneGraph.RefreshViewers</P> <P> </P><img src="images/post/smile/dvbbs/em12.gif" /><img src="images/post/smile/dvbbs/em12.gif" /><img src="images/post/smile/dvbbs/em12.gif" /><img src="images/post/smile/dvbbs/em12.gif" /> |
|
|
1楼#
发布于：2005-07-08 00:14
' Add graphic to passed papp. App needs to be ArcMap or ArcScene. If ArcMap, the graphic<BR>' is added to the BasicGraphicsLayer of the ActiveView FocusMap. If ArcScene, the graphic is<BR>' added to the BasicGraphicsLayer of the scene.<BR>'<BR>Public Sub AddGraphic(pApp As IApplication, _<BR> pGeom As IGeometry, _<BR> Optional pSym As ISymbol, _<BR> Optional bAddToSelection As Boolean = False, _<BR> Optional bSelect As Boolean = True, Optional sElementName As String) ' TODO this needs to change<BR> <BR> On Error GoTo AddGraphic_ERR<BR> <BR> If (pGeom.IsEmpty) Then<BR> Exit Sub<BR> End If<BR> <BR> Dim pElement As IElement<BR> <BR> Select Case pGeom.GeometryType<BR> Case esriGeometryPoint<BR> Set pElement = New MarkerElement<BR> Dim pPointElement As IMarkerElement<BR> Set pPointElement = pElement<BR> If (Not pSym Is Nothing) Then<BR> pPointElement.Symbol = pSym<BR> Else<BR> pPointElement.Symbol = GetDefaultSymbol(pApp, esriGeometryPoint)<BR> End If<BR> Case esriGeometryPolyline<BR> Set pElement = New LineElement<BR> Dim pLineElement As ILineElement<BR> Set pLineElement = pElement<BR> If (Not pSym Is Nothing) Then<BR> pLineElement.Symbol = pSym<BR> Else<BR> pLineElement.Symbol = GetDefaultSymbol(pApp, esriGeometryPolyline)<BR> End If<BR> Case esriGeometryPolygon<BR> Set pElement = New PolygonElement<BR> Dim pFillElement As IFillShapeElement<BR> Set pFillElement = pElement<BR> If (Not pSym Is Nothing) Then<BR> pFillElement.Symbol = pSym<BR> Else<BR> pFillElement.Symbol = GetDefaultSymbol(pApp, esriGeometryPolygon)<BR> End If<BR> Case esriGeometryMultiPatch<BR> Set pElement = New MultiPatchElement<BR> Set pFillElement = pElement<BR> If (Not pSym Is Nothing) Then<BR> pFillElement.Symbol = pSym<BR> Else<BR> pFillElement.Symbol = GetDefaultSymbol(pApp, esriGeometryPolygon)<BR> End If<BR> End Select<BR> <BR> pElement.Geometry = pGeom<BR> If Len(sElementName) > 0 Then<BR> Dim pElemProps As IElementProperties<BR> Set pElemProps = pElement<BR> pElemProps.name = sElementName<BR> End If<BR> <BR> Dim pGLayer As IGraphicsLayer<BR> If (TypeOf pApp Is IMxApplication) Then<BR> Dim pMxDoc As IMxDocument<BR> Set pMxDoc = pApp.Document<BR> <BR> Dim pActiveView As IActiveView<BR> Set pActiveView = pMxDoc.FocusMap<BR> <BR> Set pGLayer = pMxDoc.FocusMap.BasicGraphicsLayer<BR> <BR> Dim pGCon As IGraphicsContainer<BR> Set pGCon = pGLayer<BR><BR> pGCon.AddElement pElement, 0<BR><BR> Dim pGCS As IGraphicsContainerSelect<BR> Set pGCS = pGCon<BR> <BR> If (bSelect) Then<BR> If (Not bAddToSelection) Then<BR> ' unselect all other elements before selecting this one<BR> pGCS.UnselectAllElements<BR> End If<BR> pGCS.SelectElement pElement<BR> End If<BR> <BR> ' redraw graphics for entire view extent, rather than just extent of this element, in case there were<BR> ' other graphics present that became unselected and lost their selection handles<BR> If (bSelect) Then<BR> pActiveView.PartialRefresh esriViewGraphics, pElement, pActiveView.Extent<BR> Else<BR> pActiveView.PartialRefresh esriViewGraphics, pElement, Nothing<BR> End If<BR> Else<BR> Dim pSxDoc As ISxDocument<BR> Set pSxDoc = pApp.Document<BR> <BR> Set pGLayer = pSxDoc.Scene.BasicGraphicsLayer<BR> <BR> Dim pGCon3D As IGraphicsContainer3D<BR> Set pGCon3D = pGLayer<BR> <BR> pGCon3D.AddElement pElement<BR> <BR> Dim pGS As IGraphicsSelection<BR> Set pGS = pGCon3D<BR> If (bSelect) Then<BR> If (Not bAddToSelection) Then<BR> ' unselect all other elements before selecting this one<BR> pGS.UnselectAllElements<BR> End If<BR> pGS.SelectElement pElement<BR> End If<BR> <BR> pSxDoc.Scene.SceneGraph.RefreshViewers<BR> End If<BR> <BR> Exit Sub<BR>AddGraphic_ERR:<BR> Debug.Print "AddGraphic_ERR: " ; Err.Description<BR> Debug.Assert 0<BR>End Sub<BR>
|
|
|
|
2楼#
发布于：2005-07-08 00:17
函数来自 3D Developer Samples Utilities
|
|
|