Emugua
路人甲
路人甲
  • 注册日期2004-12-10
  • 发帖数22
  • QQ
  • 铜币137枚
  • 威望0点
  • 贡献值0点
  • 银元0个
阅读:1758回复:6

◆ 兄弟们,我怎样自动组合用代码画出的一组元素?有详细代码! ◆

楼主#
更多 发布于:2005-01-11 12:05
<P>兄弟们,
我在 UIToolControl1_MouseDown 事件里,画出一系列的元素(Circle,Rectangle),可是,下面的代码不能自动组合画出来的元素,以至于我不得不手工组合,将刚刚画的一些元素组合在一起。
下面是代码,可以无错运行,请大家帮我试试运行代码,补充一下自动组合的办法。</P>
<P>顺祝新年快乐!</P><img src="images/post/smile/dvbbs/em02.gif" />
喜欢0 评分0
☆⊙老老实实做人⊙☆
....
☆⊙踏踏实实做事⊙☆
----------------------------------------------
Emugua
路人甲
路人甲
  • 注册日期2004-12-10
  • 发帖数22
  • QQ
  • 铜币137枚
  • 威望0点
  • 贡献值0点
  • 银元0个
1楼#
发布于:2005-01-11 12:07
<P>可以直接将下列代码copy to ThisDocument模块里,并在ArcMap的工具条里添加一个UIToolControl1,然后运行程序,在Map上点击一下。</P><P>(代码很详细,相信高手们不会觉得浪费你的测试时间的,帮个忙,补充一下组合功能好吗?)

Private Sub UIToolControl1_MouseDown(ByVal Button As Long, ByVal Shift As Long, ByVal X As Long, ByVal Y As Long)
Dim pDoc As IMxDocument
Set pDoc = ThisDocument
Dim pActiveView As IActiveView
Set pActiveView = pDoc.FocusMap
Dim pPoint As IPoint
Set pPoint = pActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(X, Y)
Dim pGroup As IGroupElement
Set pGroup = New esriCarto.GroupElement

Dim m_Radius As Double: m_Radius = 800
Dim dStartX As Double: dStartX = pPoint.X - 3 * m_Radius
Dim dStartY As Double: dStartY = pPoint.Y - 1 * m_Radius

DrawRectangle dStartX, dStartY, 6 * m_Radius, 2 * m_Radius, pGroup
Dim i As Integer
For i = 1 To 5 Step 2
DrawCircle dStartX + i * m_Radius, dStartY + m_Radius, m_Radius, pGroup
Next
MsgBox pGroup.ElementCount, vbInformation, "Draw ElementCount" ' <<-----=======

'====================================
In this,How Automate Group Elements?
'====================================

End Sub


'=========Below Code is two Function,Can run really.

Sub DrawCircle(CenterX As Double, CenterY As Double, Radius As Double, GroupElm As IGroupElement)
Dim pDoc As IMxDocument
Dim pMap As IMap
Dim pAV As IActiveView
Dim pGc As IGraphicsContainer
Dim pElement As IElement
Dim pCircularArc As IConstructCircularArc
Dim pSegmentCollection As ISegmentCollection
Dim pCenterPoint As IPoint
Dim pPolygon As IPolygon

Set pDoc = ThisDocument
Set pMap = pDoc.FocusMap
Set pGc = pMap
Set pAV = pMap 'pGC
Set pCenterPoint = New Point
pCenterPoint.PutCoords CenterX, CenterY

Set pCircularArc = New CircularArc
pCircularArc.ConstructCircle pCenterPoint, Radius, False 'make it clockwise

Set pPolygon = New Polygon
Set pPolygon.SpatialReference = pMap.SpatialReference
Set pSegmentCollection = pPolygon
pSegmentCollection.AddSegment pCircularArc

Dim pRGB As IRgbColor
Set pRGB = New RgbColor
With pRGB
.Red = 255
.Green = 255
.Blue = 0
End With

Dim pSFSym As ISimpleFillSymbol
Set pSFSym = New SimpleFillSymbol
pSFSym.Color = pRGB
pSFSym.Style = esriSFSSolid
Dim pFSEm As IFillShapeElement

Set pElement = New CircleElement
pElement.Geometry = pPolygon
Set pFSEm = pElement
pFSEm.Symbol = pSFSym

pGc.AddElement pElement, 0
GroupElm.AddElement pElement ' <<-----=======

Set pAV = pMap
pAV.PartialRefresh esriViewGraphics, pElement, Nothing
End Sub

Sub DrawRectangle(Xmin As Double, Ymin As Double, Xlen As Double, Ylen As Double, GroupElm As IGroupElement)
Dim pDoc As IMxDocument
Dim pMap As IMap
Dim pAV As IActiveView
Dim pGc As IGraphicsContainer
Dim pElement As IElement
Dim pCenterPoint As IPoint
Dim pEnv As IEnvelope

Set pDoc = ThisDocument
Set pMap = pDoc.FocusMap

Set pGc = pMap
Set pEnv = New Envelope
pEnv.PutCoords Xmin, Ymin, Xmin + Xlen, Ymin + Ylen

Dim pRGB As IRgbColor
Set pRGB = New RgbColor
With pRGB
.Red = 128
.Green = 128
.Blue = 128
End With

Dim pSFSym As ISimpleFillSymbol
Set pSFSym = New SimpleFillSymbol
pSFSym.Color = pRGB
pSFSym.Style = esriSFSSolid
Dim pFSEm As IFillShapeElement

Set pElement = New CircleElement
pElement.Geometry = pEnv
Set pFSEm = pElement
pFSEm.Symbol = pSFSym

pGc.AddElement pElement, 0
GroupElm.AddElement pElement ' <<-----=======
Set pAV = pMap
pAV.PartialRefresh esriViewGraphics, pElement, Nothing
End Sub
</P>
☆⊙老老实实做人⊙☆
....
☆⊙踏踏实实做事⊙☆
----------------------------------------------
举报 回复(0) 喜欢(0)     评分
Emugua
路人甲
路人甲
  • 注册日期2004-12-10
  • 发帖数22
  • QQ
  • 铜币137枚
  • 威望0点
  • 贡献值0点
  • 银元0个
2楼#
发布于:2005-01-11 12:41
<P>相信不会浪费高手们的宝贵时间的。(其中的两个函数可以不用去分析)
AO帮助我看了很多遍,就是不知其所以然,唉~~</P><img src="images/post/smile/dvbbs/em02.gif" />
☆⊙老老实实做人⊙☆
....
☆⊙踏踏实实做事⊙☆
----------------------------------------------
举报 回复(0) 喜欢(0)     评分
Emugua
路人甲
路人甲
  • 注册日期2004-12-10
  • 发帖数22
  • QQ
  • 铜币137枚
  • 威望0点
  • 贡献值0点
  • 银元0个
3楼#
发布于:2005-01-11 19:36
<P>这里的高手哪去了?</P><P>不会是把我当成新手的吧,要我去看AO帮助,对吗?我连ESRI论坛都看过了。</P><P>高手,请留步,助人乃快乐之本! </P><img src="images/post/smile/dvbbs/em08.gif" />
☆⊙老老实实做人⊙☆
....
☆⊙踏踏实实做事⊙☆
----------------------------------------------
举报 回复(0) 喜欢(0)     评分
gis
gis
管理员
管理员
  • 注册日期2003-07-16
  • 发帖数15947
  • QQ554730525
  • 铜币25339枚
  • 威望15364点
  • 贡献值0点
  • 银元0个
  • GIS帝国居民
  • 帝国沙发管家
  • GIS帝国明星
  • GIS帝国铁杆
4楼#
发布于:2005-01-12 22:16
<P>组合有什么好目的吗?</P><P>先去看看再来说方法</P>
举报 回复(0) 喜欢(0)     评分
gis
gis
管理员
管理员
  • 注册日期2003-07-16
  • 发帖数15947
  • QQ554730525
  • 铜币25339枚
  • 威望15364点
  • 贡献值0点
  • 银元0个
  • GIS帝国居民
  • 帝国沙发管家
  • GIS帝国明星
  • GIS帝国铁杆
5楼#
发布于:2005-01-12 22:25
<P>这个好象不是很困难,所以你把要合并的对象选择上,然后运行下面的代码,hoho,程序是从esri上拷贝过来的,好象老兄也看过吧</P>
<P>使用接口: IGroupElement::AddElement  </P>
<P>
  Sub testing()</P>
<P>
'Group selected elements</P>
<P>
Dim pGroupElem As IGroupElement
Dim pElem As IElement
Dim pGc As IGraphicsContainer
Dim pDoc As IMxDocument</P>
<P>Set pDoc = ThisDocument
Set pGc = pDoc.FocusMap.ActiveGraphicsLayer
Set pGroupElem = New GroupElement</P>
<P>'Add each individual element to the group
'then remove the indiv element from the gc</P>
<P>
pGc.Reset
Set pElem = pGc.Next
Do Until pElem Is Nothing
    pGroupElem.AddElement pElem
    pGc.DeleteElement pElem
Set pElem = pGc.Next
Loop</P>
<P>MsgBox pGroupElem.ElementCount</P>
<P>
'Add the group element to the graphics container</P>
<P>
pGc.AddElement pGroupElem, 0
pDoc.ActiveView.Refresh</P>
<P>End Sub

</P>
[此贴子已经被作者于2005-1-12 22:27:51编辑过]
举报 回复(0) 喜欢(0)     评分
Emugua
路人甲
路人甲
  • 注册日期2004-12-10
  • 发帖数22
  • QQ
  • 铜币137枚
  • 威望0点
  • 贡献值0点
  • 银元0个
6楼#
发布于:2005-01-14 12:49
<FONT color=#ff0000 size=7>谢谢猪头外劳!</FONT><img src="images/post/smile/dvbbs/em05.gif" />
☆⊙老老实实做人⊙☆
....
☆⊙踏踏实实做事⊙☆
----------------------------------------------
举报 回复(0) 喜欢(0)     评分
游客

返回顶部