wjhgis
路人甲
路人甲
  • 注册日期2005-03-11
  • 发帖数67
  • QQ
  • 铜币359枚
  • 威望0点
  • 贡献值0点
  • 银元0个
阅读:1401回复:1

vb环境,AO中向pagelayout中添加矩形代码

楼主#
更多 发布于:2005-04-28 10:54
<P>以下代码可以在pagelayoutcontrol中添加矩形,但是填充颜色和矩形框颜色变不了!!!</P>
<P><FONT color=#4dd52b>各位有什么别的方法添加自定义颜色的矩形吗???????</FONT></P>

<P>Private Sub sbAddRectToPage() '往page中添加矩形
   '定义和设置元素接口
    Dim pElement As IElement
'    Dim pRectElement As IRectangleElement '定义矩形元素
    Dim pFillShpElement As IFillShapeElement
    Set pFillShpElement = New RectangleElement  '获取矩形元素的引用
  
    Dim pFillSym As IFillSymbol
    Dim pLnSym As ISimpleLineSymbol</P>
<P>    Set pLnSym = New SimpleLineSymbol
    Set pFillSym = New SimpleFillSymbol</P>
<P>    pLnSym.Color = GetRGBColor(0, 255, 0)
    pLnSym.Style = esriSLSSolid
    pLnSym.Width = 1</P>
<P>    pFillSym.Color = GetRGBColor(252, 236, 205)</P>
<P>    pFillSym.Outline = pLnSym</P>
<P>    pFillShpElement.Symbol.Color = pFillSym.Color
    pFillShpElement.Symbol.Outline = pFillSym.Outline</P>
<P>'    Set pRectElement = pFillShpElement
    '定义并设置图形容器接口
    Dim pGraphicContainer As IGraphicsContainer
    Dim pPageLayout As IPageLayout
    Set pPageLayout = frmSpatialAna.PageLayoutControl1.PageLayout
    Set pGraphicContainer = pPageLayout
    
    '定义并设置矩形范围接口
    Dim pEnv As IEnvelope
    Set pEnv = New Envelope
    
    Dim dMidX As Double, dMidY As Double
    dMidX = (frmSpatialAna.PageLayoutControl1.ActiveView.Extent.XMax + _
           frmSpatialAna.PageLayoutControl1.ActiveView.Extent.XMin) / 2 _
           + frmSpatialAna.PageLayoutControl1.Extent.Width / 4
    dMidY = frmSpatialAna.PageLayoutControl1.ActiveView.Extent.YMin _
           + 1 / 10 * frmSpatialAna.PageLayoutControl1.ActiveView.Extent.Height
    '设置要添加的矩形大小和位置
    pEnv.PutCoords dMidX + 0.2, dMidY + 0.2, dMidX + 3, dMidY + 1
    
  
    Set pElement = pFillShpElement
    pElement.Geometry = pEnv
    
    Set pFillShpElement = pElement
    
  
    '添加元素
    pGraphicContainer.AddElement pFillShpElement, 0
    pGraphicContainer.UpdateElement pFillShpElement
    
    frmSpatialAna.PageLayoutControl1.ActiveView.PartialRefresh esriViewGraphics, Nothing, Nothing</P>
<P>End Sub</P>
喜欢0 评分0
wjhgis
路人甲
路人甲
  • 注册日期2005-03-11
  • 发帖数67
  • QQ
  • 铜币359枚
  • 威望0点
  • 贡献值0点
  • 银元0个
1楼#
发布于:2005-04-28 10:55
敬请关注!!期待中。。。。。。。
举报 回复(0) 喜欢(0)     评分
游客

返回顶部