Mobile Element (VB source code)

 

1. Moving text elements are not as expected. Just use imovetextfeedback and imovetextalongshapefeedback. I tried this method, but it won't work. Maybe my method is incorrect.

But I implemented it in another way, as follows:

First, define two variables.

Private m_ptstart as ipoint
Private m_ptstop as ipoint

Add to the mousedown event

Dim pav as iactiveview
Pav = m_phookhelper.activeview
M_ptstart = Pav. screendisplay. displaytransformation. tomappoint (x, y)

M_hitelement = Your textelement

 

In mousemoveAdd to event

Dim pav as iactiveview
Pav = m_phookhelper.activeview
Dim Ppoint as ipoint
Ppoint = Pav. screendisplay. displaytransformation. tomappoint (x, y)
If not m_hitelem is nothing then
Dim ptrans2d as itransform2d
Ptrans2d = m_hitelem
Ptrans2d. Move (Ppoint. X-m_ptstart.x, Ppoint. Y-m_ptstart.y)
End if
Pav. partialrefresh (esriviewdrawphase. esriviewgraphics, m_zoneglayer, nothing)
M_ptstart = Ppoint

 

Add

Dim pav as iactiveview
Pav = m_phookhelper.activeview
M_ptstop = Pav. screendisplay. displaytransformation. tomappoint (x, y)

Dim pav as iactiveview
Pav = m_phookhelper.activeview
If not m_hitelem is nothing then
Dim ptrans2d as itransform2d
Ptrans2d = m_hitelem
Ptrans2d. Move (m_ptstop.x-m_ptstart.x, m_ptstop.y-m_ptstart.y)
Pav. partialrefresh (esriviewdrawphase. esriviewgraphics, m_zoneglayer, nothing)

End if

2. In the above method, if the data volume is large, it will be stranded. I used another method to solve this problem, that is, to write a class by myself and draw text on the display,

I only write a simple text drawing to provide you with an idea. Of course, you can expand and draw complex images, as shown below:

The call method is as follows:

Add the following to the mousedown event:

T = new wallfeedbacktext
T. activeview = axmapcontrol1.activeview
T. symbol = new textsymbol
T. Start (axmapcontrol1.activeview. screendisplay. displaytransformation. tomappoint (E. X, E. Y), "nihao ")

Add the following to the mousemove event:

If t isnot nothing then
T. moveTo (axmapcontrol1.activeview. screendisplay. displaytransformation. tomappoint (E. X, E. y ))
End if

Add:

If t isnot nothing then
Dim Ppoint as ipoint = T. stoptext ()
T = nothing
End if

Imports ESRI. ArcGIS. Display
Imports ESRI. ArcGIS. Geometry
Imports ESRI. ArcGIS. Carto
''' <Summary>
''' Draw the moving text, which can be expanded and draw the moving points, lines, and surfaces.
''' </Summary>
''' <Remarks> </remarks>
Public class wallfeedbacktext
Private m_av as iactiveview
Private m_sym as itextsymbol
Private m_point as ipoint
Private m_text as string
''' <Summary>
''' Current view
''' </Summary>
''' <Value> </value>
''' <Remarks> </remarks>
Writeonly property activeview () as iactiveview
Set (byval value as iactiveview)
M_av = Value
End set
End Property
''' <Summary>
''' Symbol of the application
''' </Summary>
''' <Value> </value>
''' <Returns> </returns>
''' <Remarks> </remarks>
Property symbol () as itextsymbol
Get
Return m_sym
End get
Set (byval value as itextsymbol)
M_sym = Value
End set
End Property
''' <Summary>
'''
''' </Summary>
''' <Param name = "Ppoint"> text center </param>
''' <Param name = "stext"> text content </param>
''' <Remarks> </remarks>
Sub start (byval Ppoint as ipoint, byval stext as string)
M_av.screendisplay.startdrawing (m_av.screendisplay.hdc, esriscreencache. esrinoscreencache)
M_av.screendisplay.setsymbol (m_sym)
M_text = stext
End sub
''' <Summary>
''' Move
''' </Summary>
''' <Param name = "Ppoint"> point to be moved </param>
''' <Remarks> </remarks>
Sub moveTo (byval Ppoint as ipoint)
M_av.partialrefresh (esriviewdrawphase. esriviewforeground, nothing, nothing)
M_av.screendisplay.updatewindow ()
M_av.screendisplay.drawtext (Ppoint, m_text)
M_point = Ppoint
End sub
''' <Summary>
''' Stop
''' </Summary>
''' <Returns> location of the obtained text </returns>
''' <Remarks> </remarks>
Function stoptext () as ipoint
M_av.screendisplay.finishdrawing ()
Return m_point
End Function
End Class

 

2. You can use the imovepolygonfeedback, imovelinefeedback, and imovepointfeedback interfaces to move elements of the polygon, polyline, and point types,

The method is as follows:

1. Open ArcMAP, right-click the toolbar, and select customize (or click customize under the Tools menu)

2. Select the command page in the pop-up form, select uicontrols in categorie, click New uicontrol, create a uitool, and drag it to the ArcMap toolbar.

3. Click Visual Basic Editor under macros under the Tools menu to enter the VBA environment.CodeCopy

4. Select the element to move it.

Option explicit

Private m_pdoc as imxdocument
Private m_pav as iactiveview
Private m_pscrd as iscreendisplay
Private m_pdispfeed as idisplayfeedback
Private m_phitelem as ielement
Private m_pgracont as igraphicscontainer

Private function uitoolcontrolpolicenabled () as Boolean
'Set the toolcontrol to enabled (disabled by default)
Uitoolcontrolpolicenabled = true
End Function

Private sub uitoolcontrol1_mousedown (byval button as long, byval shift as long, byval X as long, byval y as long)
Dim PPNT as ipoint
Dim pgomelem as igeometry

'Get the current mouse location in map units
Set PPNT = m_pscrd.displaytransformation.tomappoint (x, y)
'Use a function to return the first element at this point (if any)
Set m_phitelem = gethitelement (PPNT)

'If an element was returned then check what type of geometry it has (point, polyline, envelope or polygon)
If not m_phitelem is nothing then
Set pgomelem = m_phitelem.geometry
'Point Geometry
If typeof pgomelem is ipoint then
'Create a movepointfeedback object and set its display property (to the activeview's screendisplay)
Set m_pdispfeed = new movepointfeedback
Set m_pdispfeed.display = m_pscrd
'Qi for the imovepointfeedback Interface
Dim pmvptfeed as imovepointfeedback
Set pmvptfeed = m_pdispfeed
'Start the feedback using the input (point) geometry at the current mouse location
Pmvptfeed. Start pgomelem, PPNT

'Polyline Geometry
Elseif typeof pgomelem is esrigeometry. ipolyline then
'Create a movelinefeedback object and set its display property (to the activeview's screendisplay)
Set m_pdispfeed = new movelinefeedback
Set m_pdispfeed.display = m_pscrd
'Qi for the imovelinefeedback Interface
Dim pmvlnfeed as imovelinefeedback
Set pmvlnfeed = m_pdispfeed
'Start the feedback using the input (polyline) geometry at the current mouse location
Pmvlnfeed. Start pgomelem, PPNT

'Rectangle (envelope) geometry
Elseif typeof pgomelem is ienvelope then
'Create a moveenvelopefeedback object and set its display property (to the activeview's screendisplay)
Set m_pdispfeed = new moveenvelopefeedback
Set m_pdispfeed.display = m_pscrd
'Qi for the imoveenvelopefeedback Interface
Dim pmvenvfeed as imoveenvelopefeedback
Set pmvenvfeed = m_pdispfeed
'Start the feedback using the input (rectangle) geometry at the current mouse location
Pmvenvfeed. Start pgomelem, PPNT

'Polygon ry
Elseif typeof pgomelem is ipolympus Gon then
'Create a movepolygonfeedback object and set its display property (to the activeview's screendisplay)
Set m_pdispfeed = new movepolygonfeedback
Set m_pdispfeed.display = m_pscrd
'Qi for the imovepolygonfeedback Interface
Dim pmvpolyfeed as imovepolygonfeedback
Set pmvpolyfeed = m_pdispfeed
'Start the feedback using the input (polygon) geometry at the current mouse location
Pmvpolyfeed. Start pgomelem, PPNT
End if
End if
End sub

Private sub uitoolcontrol1_mousemove (byval button as long, byval shift as long, byval X as long, byval y as long)
If not m_pdispfeed is nothing then

Dim PPNT as ipoint
'Get the current mouse location in map units and move the feedback
Set PPNT = m_pscrd.displaytransformation.tomappoint (x, y)
M_pdispfeed.moveto PPNT
End if
End sub

Private sub uitoolcontrol1_mouseup (byval button as long, byval shift as long, byval X as long, byval y as long)
Dim geomresult as igeometry
Dim pgomelem as igeometry

'Check that the user is using the feedback
If not m_phitelem is nothing then
'Get the geometry type for our element again
Set pgomelem = m_phitelem.geometry

'Check what type of geometry the element has (again)
'Point Geometry
If typeof pgomelem is ipoint then
'Qi for the imovepointfeedback interface and get the finished Geometry
Dim pmvptfeed as imovepointfeedback
Set pmvptfeed = m_pdispfeed
Set geomresult = pmvptfeed. Stop
Elseif typeof pgomelem is ipolympus then
'Qi for the imovelinefeedback interface and get the finished Geometry
Dim pmvlnfeed as imovelinefeedback
Set pmvlnfeed = m_pdispfeed
Set geomresult = pmvlnfeed. Stop
Elseif typeof pgomelem is ienvelope then
'Qi for the imoveenvelopefeedback interface and get the finished Geometry
Dim pmvenvfeed as imoveenvelopefeedback
Set pmvenvfeed = m_pdispfeed
Set geomresult = pmvenvfeed. Stop

Elseif typeof pgomelem is ipolympus Gon then
'Qi for the imovepolygonfeedback interface and get the finished Geometry
Dim pmvpolyfeed as imovepolygonfeedback
Set pmvpolyfeed = m_pdispfeed
Set geomresult = pmvpolyfeed. Stop

End if

'Set the geometry of the element and call update
M_phitelem.geometry = geomresult
M_pgracont.updateelement m_phitelem

'Clear out the objects
Set m_pdispfeed = nothing
Set m_phitelem = nothing

'Refresh the activeview
M_pav.refresh
End if
End sub

Private sub uitoolcontrol1_refresh (byval HDC as long)
'Get a reference to the activeview and screendisplay
Set m_pdoc = application. Document
Set m_pav = m_pdoc.activeview
Set m_pscrd = m_pav.screendisplay
End sub

private sub uitoolcontrol1_select ()
'get a reference to the activeview and screendisplay
set m_pdoc = application. document
set m_pav = m_pdoc.activeview
set m_pscrd = m_pav.screendisplay
end sub

private function gethitelement (pinpt as ipoint) as ielement
'takes an ipoint and returns the first element that is hit (if any) in the activeview's basicgraphicslayer
dim penumelem as ienumelement
dim dblsrchdis as double
'qi for the igraphicscontainer interface from the iactiveview, allows access to the basicgraphicslayer
set m_pgracont = m_pav
'calculate the search distance (in mapunits) based upon a portion of the activeview's width
dblsrchdis = m_pav.extent.width/200
'Return an enumerator for those elements found within the search distance (in mapunits)
set penumelem = m_pgracont.locateelements (pinpt, dblsrchdis)
'if the enumerator is not empty then return the first element found
if not penumelem is nothing then
set gethitelement = penumelem. next
end if
end function