Jump to content

Programming in ArcGIS Desktop (VB.NET, VB & VBA)


yousef2233

Recommended Posts

ArcMap and ArcCaralog have plenty of toolbars, menus, and commands (buttons

and tools), enough and more for most users' needs. However, they will never have

everything that everyone needs, and will always have something that some people

simply do not. Fortunately, with a little training you will be able to change things

around, move toolbars, menus, and commands, delete ones you don't use, and create

the ones that no one could ever have predicted you'd need (Burke,GTKArcObjects, P5)

In this Topic we are going to share our codes from very simple to advanced ones. Hope we can improve the level of our knowledge.

Kindly regards,

  • Like 2
Link to comment
Share on other sites

Calculate Field for Selected Features VB.NET

'Defining pointer and types

Dim myApp As IApplication

Dim myDoc As IMxDocument

Dim myMap As IMap

Dim myTable As ITable

Dim myFeature As IFeature

Dim myFeatLayer As IFeatureLayer

Dim myFeatClass As IFeatureClass

' Pointers should be recognized to your project

myApp = CType(Hook, IApplication)

myDoc = myApp.Document

myMap = myDoc.FocusMap

'Defining Pointers

Dim pFeatLayer As IFeatureLayer

Dim pFeatClass As IFeatureClass

Dim pLayer As ILayer

pLayer = myDoc.SelectedLayer

'Check for selected layers

If pLayer Is Nothing Then

MsgBox("Must have a selected in the table of contents.")

Exit Sub

End If

pFeatLayer = pLayer

pFeatClass = pFeatLayer.FeatureClass

'FIND THE FIELD

Dim pCalc As ICalculator

Dim pTable As ITable

Dim pField As IField

Dim intFldIndex As Integer

pTable = pFeatClass

'Check for Field Name you want to calculate

intFldIndex = pTable.FindField("GISAREA")

If intFldIndex = -1 Then

MsgBox("There must be a field named GISAREA in the layer")

Exit Sub

End If

'PERFORM THE CALCULATION

pCalc = New Calculator

Dim pCursor As ICursor

'Get a cursor for the selected features

Dim pFSel As IFeatureSelection

pFSel = pFeatLayer

Dim pSelSet As ISelectionSet2

pSelSet = pFSel.SelectionSet

If pSelSet.Count = 0 Then

MsgBox("Please select features to update")

Exit Sub

End If

'Looping through selected features

pSelSet.Update(Nothing, False, pCursor)

With pCalc

.Cursor = pCursor

.Expression = "MyValue" 'you can create a variable and assign to the selected field

.Field = "GISAREA"

End With

pCalc.Calculate()

pCursor = Nothing

myMap.ClearSelection()

myDoc.ActivatedView.Refresh()

This code came from VBA Originally and it's not optimum for such operation maybe

Link to comment
Share on other sites

ArcObjects provide you some simplicity, if you have to use some predefined functions, you dont need to write codes for them. Just call their name

Suppose you are going to save the project after some editing, and this function should be automatic, so you are going to call save project

VBA:

Dim pCmdItem As ICommandItem

Set pCmdItem = Application.document.CommandBars.Find(arcid.File_Save)

pCmdItem.Execute

ESRI already prepared a list of function for you for more information look for:

http://resources.esr...e/ArcMapIds.htm

Link to comment
Share on other sites

  • 5 weeks later...

Hi!

I've started to make a button tool for ArcGis 10.1. I've installed VS2010, ArcGis 10.1 and SDK 10.1. I've made a button, build, but it doesn't work in ArcGIs. The Esri amin site off, i can't ask anyone. My goal is to click ont he button and load a layer from specified path. The code snippet (two versions) are from the ESRI developer site, but there is a problem:

If i make a button, the buttons code is that:

Protected Overrides Sub onclick()

End Sub

and the code snippet is that:

Public Sub AddLayerToActiveView(ByVal activeView As ESRI.ArcGIS.Carto.IActiveView, ByVal layerPathFile As System.String)

If activeView Is Nothing OrElse layerPathFile Is Nothing OrElse (Not layerPathFile.EndsWith(".lyr")) Then

Return

End If

' Create a new GxLayer

Dim gxLayer As ESRI.ArcGIS.Catalog.IGxLayer = New ESRI.ArcGIS.Catalog.GxLayerClass

Dim gxFile As ESRI.ArcGIS.Catalog.IGxFile = CType(gxLayer, ESRI.ArcGIS.Catalog.IGxFile) 'Explicit Cast

' Set the path for where the layerfile is located on disk

gxFile.Path = layerPathFile

' Test if we have a valid layer and add it to the map

If Not(gxLayer.Layer Is Nothing) Then

Dim map As ESRI.ArcGIS.Carto.IMap = activeView.FocusMap

map.AddLayer(gxLayer.Layer)

End If

End Sub

I dont't know, where i need to copy the add layer snippet. Into the click event sub, or i need to make a reference in the

i've modified the path of the lyr file, built the addin, installed, put the button on the screen, but the click event doesnt effect anything....

any idea?

Link to comment
Share on other sites

Although it says ' This snippet is intended to be inserted at the base level of a Class.

' It is not intended to be nested within an existing Function or Sub, You can put your codes under appropriate section, if you want your button perform an action, write between Protected Overrides Sub onclick()

and End Sub

sth like this

Protected Overrides Sub onclick()

cmbFields.ClearMe()

myApp = CType(Hook, IApplication)

myDoc = myApp.Document

myMap = myDoc.FocusMap

myLayer = myDoc.SelectedLayer

Dim myComboBox As cmbFields = cmbFields.GetComboBox()

If myLayer Is Nothing Then

MsgBox("There is no selected Layers in TOC")

Exit Sub

End If

cmbFields.ClearMe()

myTable = myLayer

For i = 0 To myTable.FieldCount - 1

'MsgBoxmy(Table.Field(i).Name)

cmbFields.FillMe(myTable.Field(i).Name.ToString)

Next i

End Sub

Put Breaks on line which you want you check.

Link to comment
Share on other sites

mine is working >>>>

Imports ESRI.ArcGIS.Carto

Imports ESRI.ArcGIS.Catalog

Imports ESRI.ArcGIS.Geodatabase

Imports ESRI.ArcGIS.esriSystem

Imports ESRI.ArcGIS.SystemUI

Imports ESRI.ArcGIS.Framework

Imports ESRI.ArcGIS.ArcMapUI

Public Class AddLayer

Inherits ESRI.ArcGIS.Desktop.AddIns.Button

Public Sub New()

End Sub

Protected Overrides Sub onclick()

'

' TODO: Sample code showing how to access button host

'

Dim myApp As IApplication

Dim myDoc As IMxDocument

myApp = CType(Hook, IApplication)

myDoc = myApp.Document

Dim myMap As IMap

myMap = myDoc.FocusMap

Dim activeView As IActiveView

Dim layerPathFile As System.String

layerPathFile = "D:\Data\Land_Use_83_SHP\Land_Use_Appended.lyr"

activeView = myDoc.ActivatedView

If activeView Is Nothing OrElse layerPathFile Is Nothing OrElse (Not layerPathFile.EndsWith(".lyr")) Then

Return

End If

' Create a new GxLayer

Dim gxLayer As ESRI.ArcGIS.Catalog.IGxLayer = New ESRI.ArcGIS.Catalog.GxLayerClass

Dim gxFile As ESRI.ArcGIS.Catalog.IGxFile = CType(gxLayer, ESRI.ArcGIS.Catalog.IGxFile) 'Explicit Cast

' Set the path for where the layerfile is located on disk

gxFile.Path = layerPathFile

' Test if we have a valid layer and add it to the map

If Not (gxLayer.Layer Is Nothing) Then

Dim map As ESRI.ArcGIS.Carto.IMap = activeView.FocusMap

map.AddLayer(gxLayer.Layer)

End If

My.ArcMap.Application.CurrentTool = Nothing

End Sub

Protected Overrides Sub OnUpdate()

Enabled = My.ArcMap.Application IsNot Nothing

End Sub

End Class

btw I'm new to ArcObjects.Net :P

Link to comment
Share on other sites

yeah man:)

still working by meh too...

A second question > i want to make my old tool, with .net (before i made with vba in 9.3.1 arcgis), i want to click, popup a window with the map coord (x,y in integer form) and copy to the clipboard.

for the coordinates i've found this snippet:

Imports ESRI.ArcGIS.Geometry

Imports ESRI.ArcGIS.Display

Imports ESRI.ArcGIS.Carto

Public Class koord

#Region "Get Map Coordinates from Screen Coordinates"

'''<summary>Obtain the real world (map) coordinates from the device (screen) coordinates.</summary>

'''

'''<param name="screenPoint">An IPoint interface that contains the X,Y values from the device (screen) in your Windows application.</param>

'''<param name="activeView">An IActiveView interface</param>

'''

'''<returns>An IPoint interface containing the real world (map) coordinates is returned.</returns>

'''

'''<remarks></remarks>

Public Function GetMapCoordinatesFromScreenCoordinates(ByVal screenPoint As IPoint, ByVal activeView As IActiveView) As IPoint

If screenPoint Is Nothing OrElse screenPoint.IsEmpty OrElse activeView Is Nothing Then

Return Nothing

End If

Dim screenDisplay As IScreenDisplay = activeView.ScreenDisplay

Dim displayTransformation As IDisplayTransformation = screenDisplay.DisplayTransformation

Return displayTransformation.ToMapPoint(CInt(screenPoint.X), CInt(screenPoint.Y))

End Function

#End Region

i made a mousedown method, and i want to invoke the function:

Public Sub coord_copy_MouseDown()

Dim xcoord As String

Dim ycoord As String

xcoord = GetMapCoordinatesFromScreenCoordinates(????arguments)

ycoord = GetMapCoordinatesFromScreenCoordinates(????arguments)

'and this is a sketch

msgbox xcoord,ycoord

put_it:on:clipboard(xcoord,ycoord)

End Sub

any idea? Sry i don't know where i need to search "how to invoke" an arcgis function...

Link to comment
Share on other sites

hi!

i've tested the code but can't work...

in visual studio2010 made a button, insterted a code snippet > get map coordinate from screen, and made a modusedown event, with that code above...but many errors, can't build...

But i've found that > http://forums.arcgis.com/threads/21220-add-in-button-mouse-down-capture

Here is an example, to make a tool instead a button. The tool runs the code after clicking on the screen. I've copied, and wanted to test, but this code runs silent, so i need to drop a msgbox with the x,y coord (to see the coord result) + put it on the clipboard

any idea?

Link to comment
Share on other sites

Imports ESRI.ArcGIS.Framework

Imports ESRI.ArcGIS.ArcMapUI

Imports ESRI.ArcGIS.Geometry

Public Class DisplayXY

Inherits ESRI.ArcGIS.Desktop.AddIns.Tool

Public Sub New()

End Sub

Protected Overrides Sub OnUpdate()

Enabled = My.ArcMap.Application IsNot Nothing

End Sub

Protected Overrides Sub onmousedown(ByVal arg As ESRI.ArcGIS.Desktop.AddIns.Tool.MouseEventArgs)

MyBase.onmousedown(arg)

Dim myApp As IApplication

Dim myDoc As IMxDocument

myApp = CType(Hook, IApplication)

myDoc = myApp.Document

Dim myPoint As IPoint

myPoint = myDoc.CurrentLocation

Dim XY As String

XY = "X: " & myPoint.X & " Y: " & myPoint.Y

MsgBox(XY)

My.Computer.Clipboard.SetText(XY)

End Sub

End Class

WORKS FINE :)

Link to comment
Share on other sites

hem, you are wizard...thx a lot, it works fine by me too!

Something is wrong with meh, i don't understand the .net coding...vba was a bit simple...

Next day i will test it and maybe a bit change something, to format the output coord style (integer x y instead single/long formatted coords)

but, again, thx mate! I hope it helps other guys too!

olla

Link to comment
Share on other sites

  • 3 weeks later...

hello, i'm newbie in gis programming,

well, i wanna makea program usingvba in arcgis, in many algorithm, i need geoprocessing tool such overlay, extract, buffering etc. but when i search in http://edndoc.esri.com/arcobjects/9.0/Samples/Geoprocessing/RunToolWithGPDispatch.htm, and debug the script below, i getnothing..there are any error in script. actually, i have changed the directory of the script usingmy file. would you like to helpme,please?

Sub RunGPTool_click()

'Create the Geoprocessor object

Dim GP As Object

Set GP = CreateObject("esriGeoprocessing.GpDispatch.1")

'Set the toolbox

GP.Toolbox = "D:\ArcGIS\ArcToolbox\Toolboxes\Analysis Tools.tbx"

'Execute tools

GP.Clip "D:\Workspace\Portland.mdb\Region\streets", _

"D:\Workspace\Portland.mdb\Region\downtown", "D:\Workspace\Portland.mdb\Region\dt_streets"

GP.Buffer "D:\Workspace\Portland.mdb\Region\dt_streets", _

"D:\Workspace\Portland.mdb\Region\dt_streetsbuf", "500"

End Sub

saya merubah lokasi file dengan file yang akansaya clipdan buffer, tapi ketika di debug, terdapat kesalahan.

dapatkah kakak membantu saya untuk permasalahan ini?

maaf jikamerepotkan, terimakas

Link to comment
Share on other sites

hello all,

i wanna make a program of arcobject based vba, in my program, i've an algorithm :

1st step, choose file we need

2nd step, determine a process we want

3rd step, the file in 1st step will be process as the process chosen in 2nd step.

hearby mu code:

1st step:

Public Sub CommandButton1_Click()

Dim pMxDoc As IMxDocument

Set pMxDoc = ThisDocument

Dim pGxDialog As IGxDialog

Set pGxDialog = New GxDialog

pGxDialog.AllowMultiSelect = True

pGxDialog.Title = "Select Feature Classes to Add To Map"

Dim pGxFilter As IGxObjectFilter

Set pGxFilter = New GxFilterFeatureClasses

Set pGxDialog.ObjectFilter = pGxFilter

Dim pGxObjects As IEnumGxObject

pGxDialog.DoModalOpen Thisdocument.Parent.hWnd, pGxObjects

If (pGxObjects Is Nothing) Then Exit Sub

pGxObjects.Reset

Dim pLayer As IFeatureLayer

Dim pGxDataset As IGxDataset

Set pGxDataset = pGxObjects.Next

Do Until (pGxDataset Is Nothing)

Set pLayer = New FeatureLayer

Set pLayer.FeatureClass = pGxDataset.Dataset

pLayer.Name = pLayer.FeatureClass.AliasName

pMxDoc.FocusMap.Addlayer pLayer

Set pGxDataset = pGxObjects.Next

Loop

pMxDoc.ActiveView.PartialRefresh esriViewGeography, Nothing, Nothing

End Sub

2nd step

Public Sub ComboBox1_DropButtonclick()

With ComboBox1

.AddItem "Flood region"

.AddItem "Urban distance"

.AddItem "Roadway distance"

.AddItem "Topograph"

.AddItem "Slope"

.AddItem "Environmental load"

End With

End Sub

well, in 3rd step i dont know how to recall file opened in step 1st, as usual, I think I can call it by codein vb6 that is : open pMxDocfor input as #1, but when i used it, it doesn't work..

I do really need your help

Link to comment
Share on other sites

Dim pDoc As IMxDocument

Dim pLayer As IFeatureLayer

Dim pFeatClass As IFeatureClass

Set pDoc = ThisDocument

If Not pDoc.SelectedLayer Is Nothing Then

Set pLayer = pDoc.SelectedLayer

Else

MsgBox "No Layers Selected in TOC"

Exit Sub

End If

Dim LayerPath As String

Set pFeatClass = pLayer.FeatureClass

Dim pDataset As IDataset

Set pDataset = pFeatClass

Dim pWorkspace As IWorkspace

Set pWorkspace = pDataset.Workspace

Dim FCPath As String

FCPath = pWorkspace.PathName & "/" & pLayer.Name

'MsgBox (FCPath)

'------- Function ------- a simple function

Dim GP As Object

Set GP = CreateObject("esriGeoprocessing.GpDispatch.1")

'GP.Buffer_analysis FCPath, "D:\GISAREA\Buffer.shp", "50000"

GP.MakeFeatureLayer_management FCPath, "GISAREA"

'Works Fine ;)

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...

Important Information

By using this site, you agree to our Terms of Use.

Disable-Adblock.png

 

If you enjoy our contents, support us by Disable ads Blocker or add GIS-area to your ads blocker whitelist