阅读:1915回复:6
◆ 兄弟们,我怎样自动组合用代码画出的一组元素?有详细代码! ◆
<P>兄弟们,
我在 UIToolControl1_MouseDown 事件里,画出一系列的元素(Circle,Rectangle),可是,下面的代码不能自动组合画出来的元素,以至于我不得不手工组合,将刚刚画的一些元素组合在一起。 下面是代码,可以无错运行,请大家帮我试试运行代码,补充一下自动组合的办法。</P> <P>顺祝新年快乐!</P><img src="images/post/smile/dvbbs/em02.gif" /> |
|
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> |
|
2楼#
发布于:2005-01-11 12:41
<P>相信不会浪费高手们的宝贵时间的。(其中的两个函数可以不用去分析)
AO帮助我看了很多遍,就是不知其所以然,唉~~</P><img src="images/post/smile/dvbbs/em02.gif" /> |
|
3楼#
发布于:2005-01-11 19:36
<P>这里的高手哪去了?</P><P>不会是把我当成新手的吧,要我去看AO帮助,对吗?我连ESRI论坛都看过了。</P><P>高手,请留步,助人乃快乐之本! </P><img src="images/post/smile/dvbbs/em08.gif" />
|
|
4楼#
发布于:2005-01-12 22:16
<P>组合有什么好目的吗?</P><P>先去看看再来说方法</P>
|
|
|
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编辑过]
|
|
|
6楼#
发布于:2005-01-14 12:49
<FONT color=#ff0000 size=7>谢谢猪头外劳!</FONT><img src="images/post/smile/dvbbs/em05.gif" />
|
|