Avenue Wraps Samples
1. Getting Started
Document Related Samples
2. How to create a New Frame (View)
3. How to activate a Specific Frame (View)
4. How to change from a Data View to the Layout View
5. How to change from the Layout View to a Data View
6. How to get a list of active (selected) themes in the view
7. How to get a list of all themes in the view
8. How to get a list of all themes in the view expanding group layers
9. How to get a list of all feature layers in the view
10. How to get a list of all visible themes in the view
11. How to get a list of all tables in the view
12. How to add a Layer File programmatically
Theme and Table Related Samples
13. How to get the attribute table (FTab) for a theme
14. How to get the virtual table (VTab) for a table
15. How to determine theme type (point, polyline, polygon)
16. How to select all features in a theme
17. How to select a specific feature in a theme
18. How to delete all features in a theme
19. How to delete the selected features in a theme
20. How to delete a specific feature in a theme
21. How to select all records in a table
22. How to select a specific record in a table
23. How to delete all records in a table
24. How to delete the selected records in a table
25. How to delete a specific record in a table
26. How to uniquely classify a theme
27. How to store a value in a specific field for a specific record in a theme
28. How to store a value in a specific field for a specific record in a table
29. How to cycle through all features in a theme
30. How to cycle through the selected features for a theme
31. How to programmatically create a shapefile and add it to the view
32. How to prompt the user for the name of a shapefile and add it to the view
33. How to programmatically create a table and add it to the view
34. How to cycle through all records in a table
35. How to cycle through the selected features for a table
36.
How to cycle through all features/rows or the selected features/rows for a
layer/table using a Cursor
37. How to determine the type of a field
38. How to get the unique values of a field for a theme or a table
39. How to determine the type of a theme
File I/O Samples
40. How to write and read data to an ASCII file - Example 1
41. How to write and read data to an ASCII file - Example 2
Utility Samples
42. How to create and sort a collection (list)
43. How to display a progress bar without a stop or cancel button
44. How to display a progress bar with a stop or cancel button
45. Formatting numbers as strings
46. Hot to get and format the current Date
47. Drawing Graphic Text
Legend and Classification Samples
48. How to assign a unique classification to a theme
49. How to process labels and symbols in a classification
Feature Geometry Samples
50. How to create polyline geometry from a list of coordinates
51. How to process polyline geometry
52. How to process polygon geometry
Message Box Samples
53. How to create a dialog box combining data line and combo-box items
Join and Link Samples
54. How to join a table to a theme
55. How to link a table to a theme
56. How to link two themes and zoom to the Selected Features
Graphic Elements Samples
57. How to find graphic elements in an Annotation Group layer
58. How to parse the graphic elements in the Layout View
59. How to find all of the graphic text elements in a Data View
60. How to find all of the graphic text elements in the Layout View
61. How to convert selected graphic text elements into Callouts
Printing Samples
62. How to print the current map
63. How to print the current map from the Layout View
Attribute Editing Sample
64. How to display and edit the attributes of a selected feature
1. Getting Started
The first step in using the Avenue Wraps "wraparounds" is to reference the Avenue Wraps DLL file, avwraps.dll. It is recommended that the DLL implementation, rather than the Avenue Wraps document file, avwraps.mxd, be used, essentially for two reasons. The first is that the document file requires ArcGIS Version 8.2. If the user is not using this version, the user will not be able to open the document file. The second reason is that the DLL implementation does not include the Avenue Wraps code so that the application which the user develops will be smaller in size. If the user wishes to modify the Avenue Wraps "wraparounds", the VB project file, avwraps.vbp, can be used to create a new DLL version of the Avenue Wraps "wraparounds".
The following steps describe how to reference the avwraps.dll file in a new ArcMap document file (8.x or 9.x).
1 Invoke ArcMap.
2 Accept the default selection to create a new empty map, and click at the OK button.
3 Click at the Tools menu and then at the Macros and Visual Basic Editor sub-menus.
4 Click at the Tools menu and then at the References... sub-menu.
5 Click at the Browse button to display the Add Reference file dialog box.
6 Navigate to the directory in which the avwraps.dll file is located.
7 Click at the name of the avwraps.dll file.
8 Click at the Open button.
9 Click at the OK button to confirm.
10 Click in the square containing the plus (+) character to the left of the folder called ArcMap Objects under the Project group in the Project window.
11 Double-click on the ThisDocument module name.
12 Scroll down in the Object drop-down list and select the MxDocument name.
13 Scroll down in the Procedure drop-down list and select the OpenDocument name.
14 Insert the line Call avInit(Application) in the OpenDocument procedure.
15 Click the Run Sub/UserForm tool to execute the subroutine. This will initialize the Avenue Wraps global variables.
The avwraps.dll has now been referenced in the VBA application, and all of the Avenue Wraps are now available to the developer. The user can now create new modules and begin to convert existing Avenue code or develop new code using the Avenue Wraps "wraparounds".
Note that any time a new module is inserted in the ArcMap document file, the OpenDocument procedure will need to be re-executed. The OpenDocument procedure is a good location to perform any initialization that may be required.
2. How to create a New Frame (View)
'
Dim pMxApp As IMxApplication
Dim pmxDoc As IMxDocument
Dim pActiveView As IActiveView
Dim pMap As IMap
'
' ---Get the active view
Call avGetActiveDoc(pMxApp, pmxDoc, pActiveView, pMap)
'
' ---Create a new frame or view
Set pMap = avViewMake
'
' ---Activate the new frame or view
Set pActiveView = pmxdoc.ActiveView
'
' ---Check if we are in Layout view
If TypeOf pActiveView Is IPageLayout Then
Set pmxdoc.ActiveView.FocusMap = pMap
' ---Handle case when we are in Data view
Else
Set pmxdoc.ActiveView = pMap
End If
'
' ---Define the name of the new frame
pMap.Name = "New_View"
'
' ---Update the Table of Contents to reflect the name change
' ---of the new frame or view
Call avInvalidateTOC(Null)
'
' ---Set the map and distance units for the new frame
pMap.MapUnits = esriInches
pMap.DistanceUnits = esriInches
3. How to activate a Specific Frame (View)
This sample illustrates how a list of the data frames in the
current
document can be presented to the user in a
choice message box, from which,
the user can select one, which then becomes
the active data frame in
the current document. If this procedure is run from the Layout
View,
the code below will change the map display
to be in Data View after
activating the data frame.
'
Dim pMxApp As IMxApplication
Dim pmxDoc As IMxDocument
Dim pActiveView As IActiveView
Dim pMap As IMap
Dim aList As New
Collection
Dim pMaps As IMaps
Dim D As
Long
Dim aMap As IMap
Dim ians
As Variant
Dim doc_name As Variant
Dim pApp
As IApplication
Dim pUID As New UID
Dim pCmdItem As
ICommandItem
'
' ---Handle any
errors that may occur
On Error GoTo
Errorhandler
'
' ---Get the active view
Call avGetActiveDoc(pMxApp, pmxDoc, pActiveView, pMap)
'
' ---
' ---Get a list of
the maps in the current document
' ---
Call CreateList(aList)
Set pMaps = pmxdoc.Maps
For D = 1 To pMaps.Count
Set aMap = pMaps.Item(D - 1)
aList.Add (aMap.Name)
Next
'
' ---
' ---Sort the data
frames alphabetically in an ascending order
' ---
Call SortTwoLists(aList, Nothing,
Null, True)
'
' ---
' ---Get the data
frame that is to be activated
' ---
Call avMsgBoxChoice(aList, _
"Select the Data Frame to be Activated:",
_
"Activate Data Frame", ians)
'
' ---Check if the
command is to be aborted
If (IsNull(ians))
Then
Exit Sub
End If
'
' ---
' ---Find the data
frame and set the IMap object
' ---
doc_name = Null
For D = 1 To pMaps.Count
Set aMap = pMaps.Item(D - 1)
If (UCase(aMap.Name) = UCase(ians)) Then
doc_name = ians
Exit For
End If
Next
'
' ---
' ---Check if an
existing frame or view was found
' ---
If (Not IsNull(doc_name)) Then
'
' ---Activate the data
frame
Set pActiveView =
pmxdoc.ActiveView
'
' ---Determine if we are
in a Data View or the Layout View
If TypeOf pActiveView Is IPageLayout Then
'
' ---Handle case when
we are in the Layout View
'
' ---Set the map
focus to be the map selected by the user
Set
pmxdoc.ActiveView.FocusMap = aMap
'
' ---Get the
IApplication object
Set pApp = pMxApp
'
' ---Define the GUID
of the Data View command
pUID.Value =
"{65702489-A258-11D1-8740-0000F8751720}"
'
' ---Find the command
Set pCmdItem = pApp.Document.CommandBars.Find(pUID)
'
' ---Execute the
command to change from Layout View to Data View
pCmdItem.Execute
'
' ---Handle case when we
are in the Data View
Else
'
' ---Set the active
view to be the map selected by the user
Set pmxdoc.ActiveView
= aMap
End If
'
' ---Redefine the IMap
object in case we need to do something
' ---with it later on in
this procedure
Set pMap =
pmxdoc.FocusMap
'
' ---Update the TOC
Call avInvalidateTOC(Null)
'
' ---Make sure the
display is current
Call avGetDisplayFlush
End If
'
Exit Sub
'
' ---Handle any
errors that were detected
Errorhandler:
'
' ---Display the
detected error
Call avMsgBox("Error "
& Err.Number & " - " & Err.Description & _
Chr(13) &
"Subroutine: ActivateDataFrame")
4. How to change from a Data View to the Layout View
This sample illustrates how to change the display from a Data View
to
the Layout View programmatically. This
sample assumes that the active
map is already in a Data View.
'
Dim pMxApp As IMxApplication
Dim pmxDoc As IMxDocument
Dim pActiveView As IActiveView
Dim pMap As IMap
Dim pPageLayout As
IPageLayout
Dim pScreenDisplay As
IScreenDisplay
Dim pDT
As IDisplayTransformation
'
' ---Get the active view
Call avGetActiveDoc(pMxApp, pmxDoc, pActiveView, pMap)
'
' ---Change the
display to be in Layout view, which will change the map
' ---display to be in
Layout view
Set pmxdoc.ActiveView =
pmxdoc.PageLayout
Set pmxdoc.ActiveView.FocusMap
= pMap
'
' ---Define the
IPageLayout object
Set pPageLayout =
pmxdoc.PageLayout
'
' ---Redefine the
IActiveView object using the IPageLayout object
Set pActiveView =
pPageLayout
'
' ---Get the display
and transformation for the Layout. Since
the
' ---IActiveView
object was QI’d using pPageLayout we will get
' ---the display for
the Layout View, not the Data View, for the
' ---active map. In so doing we can get the visible bounds,
units
' ---and other
display properties for the Layout View.
Set pScreenDisplay =
pActiveView.ScreenDisplay
Set pDT
= pActiveView.ScreenDisplay.DisplayTransformation
5. How to change from the Layout View to a Data View
This sample illustrates how to change the map display from the Layout
View to a Data View programmatically. This sample assumes that the
active map is already in the Layout View.
'
Dim pMxApp As IMxApplication
Dim pmxDoc As IMxDocument
Dim pActiveView As IActiveView
Dim pMap As IMap
Dim pApp
As IApplication
Dim pUID As New UID
Dim pCmdItem As
ICommandItem
'
' ---Get the active view
Call avGetActiveDoc(pMxApp, pmxDoc, pActiveView, pMap)
'
' ---Change the map
focus to be the active map
If (pmxdoc.FocusMap.Name
<> pMap.Name) Then
Set pmxdoc.ActiveView.FocusMap
= pMap
End If
'
'
---Get the IApplication object
Set pApp
= pMxApp
'
'
---Define the GUID of the Data View command
pUID.Value =
"{65702489-A258-11D1-8740-0000F8751720}"
'
'
---Find the command
Set pCmdItem = pApp.Document.CommandBars.Find(pUID)
'
'
---Execute the command to change the display to be in Data View
pCmdItem.Execute
6. How to get a list of active (selected) themes in the view
'
Dim pMxApp As IMxApplication
Dim pmxDoc As IMxDocument
Dim pActiveView As IActiveView
Dim pMap As IMap
Dim themeList As New Collection
'
' ---Get the active view
Call avGetActiveDoc(pMxApp, pmxDoc, pActiveView, pMap)
'
' ---Get a list of the active (selected) themes
Call avGetActiveThemes(pmxDoc, themeList)
7. How to get a list of all themes in the view
'
Dim pMxApp As IMxApplication
Dim pmxDoc As IMxDocument
Dim pActiveView As IActiveView
Dim pMap As IMap
Dim themeList As New Collection
'
' ---Get the active view
Call avGetActiveDoc(pMxApp, pmxDoc, pActiveView, pMap)
'
' ---Get a list of all themes (group
layers are not expanded, that is
' ---only the name of the group layer
is returned, the names of the
' ---layers within the group layer are
ignored)
Call avGetThemes(pmxDoc, 0, themeList)
8. How to get a list of all themes in the view expanding group layers
'
Dim pMxApp As IMxApplication
Dim pmxDoc As IMxDocument
Dim pActiveView As IActiveView
Dim pMap As IMap
Dim themeList As New Collection
'
' ---Get the active view
Call avGetActiveDoc(pMxApp, pmxDoc, pActiveView, pMap)
'
' ---Get a list of all themes (group
layers are expanded, the name of
' ---the group layer is not included,
but rather, the names of the
' ---layers within the group layer are
returned)
Call avGetThemes(pmxDoc, 5, themeList)
9. How to get a list of all feature layers in the view
'
Dim pMxApp As IMxApplication
Dim pmxDoc As IMxDocument
Dim pActiveView As IActiveView
Dim pMap As IMap
Dim themeList As New Collection
'
' ---Get the active view
Call avGetActiveDoc(pMxApp, pmxDoc, pActiveView, pMap)
'
' ---Get a list of only the feature layers
Call avGetThemes(pmxDoc, 4, themeList)
10. How to get a list of all visible themes in the view
'
Dim pMxApp As IMxApplication
Dim pmxDoc As IMxDocument
Dim pActiveView As IActiveView
Dim pMap As IMap
Dim themeList As New Collection
'
' ---Get the active view
Call avGetActiveDoc(pMxApp, pmxDoc, pActiveView, pMap)
'
' ---Get a list of all visible themes, only annotation and feature
' ---layers are passed back, all other layer types are ignored. Note
' ---that if the theme has been assigned scale threshold values, these
' ---values must be satisfied in order for the theme to be considered
' ---visible.
Call avGetVisibleThemes(pmxDoc, themeList)
11. How to get a list of all tables in the view
'
Dim pMxApp As IMxApplication
Dim pmxDoc As IMxDocument
Dim pActiveView As IActiveView
Dim pMap As IMap
Dim themeList As New Collection
'
' ---Get the active view
Call avGetActiveDoc(pMxApp, pmxDoc, pActiveView, pMap)
'
' ---Get a list of only the tables
Call avGetThemes(pmxDoc, 2, themeList)
12. How to add a Layer File programmatically
'
Dim pMxApp As
IMxApplication
Dim pmxdoc As IMxDocument
Dim pActiveView As
IActiveView
Dim pMap As IMap
Dim pGxLayer As IGxLayer
Dim pGxFile As IGxFile
Dim strLayerPath As
String
Dim theLayer As String
'
' ---Get the active
view
Call avGetActiveDoc(pMxApp, pmxdoc,
pActiveView, pMap)
'
' ---Create a new
IGxLayer object
Set pGxLayer = New
GxLayer
'
' ---Create a new
IGxFile object and assign the IGxLayer object to it
Set pGxFile = pGxLayer
'
' ---Define the full
pathname of the layer file to be added
strLayerPath
= "c:\temp\zzzz.lyr"
'
' ---Assign the
pathname to the IGxFile object
pGxFile.Path =
strLayerPath
'
' ---Make sure the
pathname exists
If Not pGxLayer.Layer Is
Nothing Then
'
' ---Define the name of
the layer that will be added when the
' ---layer file is added
below
theLayer
= "THEME1"
'
' ---Check if the layer
exists in the map
If (avFindDoc(theLayer) <> -1)
Then
' ---Remove the layer
from the map so that we do not get a
' ---duplicate layer
Call avRemoveDoc(theLayer)
End If
'
' ---Add the layer file
to the current map
pMap.AddLayer
pGxLayer.Layer
End If
13.
How to get the attribute table (FTab) for a theme
'
Dim pMxApp As IMxApplication
Dim pmxDoc As IMxDocument
Dim pActiveView As IActiveView
Dim pMap As IMap
Dim themeList As New Collection
Dim theTheme As Variant
Dim theFTab As IFields
Dim pFClass As IFeatureClass
Dim pFLayer As IFeatureLayer
'
' ---Get the active view
Call avGetActiveDoc(pMxApp, pmxDoc, pActiveView, pMap)
'
' ---Get a list of only the feature layers
Call avGetThemes(pmxDoc, 4, themeList)
'
' ---Extract the first theme in the list
theTheme = themeList.Item(1)
'
' ---Get the attribute table (FTab) for the theme
Call avGetFTab(pmxDoc, theTheme, theFTab, pFClass, pFLayer)
14. How to get the virtual table (VTab) for a table
'
Dim pMxApp As IMxApplication
Dim pmxDoc As IMxDocument
Dim pActiveView As IActiveView
Dim pMap As IMap
Dim themeList As New Collection
Dim theTable As Variant
Dim theVTab As IFields
'
' ---Get the active view
Call avGetActiveDoc(pMxApp, pmxDoc, pActiveView, pMap)
'
' ---Get a list of only the tables
Call avGetThemes(pmxDoc, 2, themeList)
'
' ---Extract the first table in the list
theTable = themeList.Item(1)
'
' ---Get the virtual table (VTab) for the table
Call avGetVTab(pmxDoc, theTable, theVTab)
15. How to determine theme type (point, polyline, polygon)
'
Dim pMxApp As IMxApplication
Dim pmxDoc As IMxDocument
Dim pActiveView As IActiveView
Dim pMap As IMap
Dim themeList As New Collection
Dim aTitle As String
Dim nThms As Long
Dim errString As String
Dim iThm As Long
Dim aThm As Variant
Dim pUnknown As IUnknown
Dim aName As Variant
Dim aType As Integer
Dim theFTab As IFields
Dim pFClass As IFeatureClass
Dim pFLayer As IFeatureLayer
Dim shapeType As esriGeometryType
'
' ---Get the active view
Call avGetActiveDoc(pMxApp, pmxDoc, pActiveView, pMap)
'
' ---Get a list of all themes
Call avGetThemes(pmxDoc, 0, themeList)
'
' ---Define the message box title (caption)
aTitle = "Avenue Wraps Sample"
'
' ---Determine the number of themes to be processed
nThms = themeList.count
'
' ---Check if there are no themes in the map
If (nThms <= 0) Then
errString = "No themes exist in the map."
Call avMsgBoxWarning(errString, aTitle)
Exit Sub
End If
'
' ---Cycle thru the themes in the map
For iThm = 1 To nThms
'
' ---Get the name of the theme
aThm = themeList.Item(iThm)
'
' ---Get the IUnknown interface for the layer
Set pUnknown = FindLayer(pMap, aThm)
'
' ---Find out what it is we are dealing with
' ---aType 0 = unknown
' ---aType 1 = standalone table
' ---aType 2 = raster layer
' ---aType 3 = tin layer
' ---aType 4 = annotation layer
' ---aType 5 = feature layer
' ---aType 6 = CAD annotation layer
' ---aType 7 = CAD layer
Call avGetLayerType(pUnknown, aName, aType)
'
' ---Check for a feature layer (shape type can only be checked
' ---for feature layers)
If (aType = 5) Then
'
' ---Get the feature class for the theme
Call avGetFTab(pmxDoc, aThm, theFTab, pFClass, pFLayer)
'
' ---Determine the shape type using the feature class
shapeType = pFClass.shapeType
'
' ---Perform a check for the type of feature we have, once
' ---found code can be written to perform some task
'
' ---Polyline Feature
If (shapeType = esriGeometryPolyline)) Then
'
' ---Polygon Feature
ElseIf (shapeType = esriGeometryPolygon)) Then
'
' ---Point Feature
ElseIf (shapeType = esriGeometryPoint)) Then
'
End If
'
' ---Something other than a feature layer selected
Else
'
End If
Next
16. How to select all features in a theme
'
Dim pMxApp As IMxApplication
Dim pmxDoc As IMxDocument
Dim pActiveView As IActiveView
Dim pMap As IMap
Dim themeList As New Collection
Dim theTheme As Variant
Dim sel As ISelectionSet
'
' ---Get the active view
Call avGetActiveDoc(pMxApp, pmxDoc, pActiveView, pMap)
'
' ---Get a list of only the feature layers
Call avGetThemes(pmxDoc, 4, themeList)
'
' ---Extract the first theme in the list
theTheme = themeList.Item(1)
'
' ---Select all features in the theme
Call avSetAll(pmxDoc, theTheme, sel)
Call avUpdateSelection(pmxDoc, theTheme)
'
' ---Update the display to reflect the new selection
Call avGetDisplayFlush
17. How to select a specific feature in a theme
'
Dim pMxApp As IMxApplication
Dim pmxDoc As IMxDocument
Dim pActiveView As IActiveView
Dim pMap As IMap
Dim themeList As New Collection
Dim theTheme As Variant
Dim rec As Long
'
' ---Get the active view
Call avGetActiveDoc(pMxApp, pmxDoc, pActiveView, pMap)
'
' ---Get a list of only the feature layers
Call avGetThemes(pmxDoc, 4, themeList)
'
' ---Extract the first theme in the list
theTheme = themeList.Item(1)
'
' ---Clear the current selection set for the theme
Call avClearSelection(pmxDoc, theTheme)
Call avUpdateSelection(pmxDoc, theTheme)
'
' ---Update the display to reflect the new selection
Call avGetDisplayFlush
'
' ---Select the specific record, 12, in the theme
Call avBitmapSet(pmxDoc, theTheme, rec)
Call avUpdateSelection(pmxDoc, theTheme)
'
' ---Update the display to reflect the new selection
Call avGetDisplayFlush
18. How to delete all features in a theme
'
Dim pMxApp As IMxApplication
Dim pmxDoc As IMxDocument
Dim pActiveView As IActiveView
Dim pMap As IMap
Dim themeList As New Collection
Dim theTheme As Variant
'
' ---Get the active view
Call avGetActiveDoc(pMxApp, pmxDoc, pActiveView, pMap)
'
' ---Get a list of only the feature layers
Call avGetThemes(pmxDoc, 4, themeList)
'
' ---Extract the first theme in the list
theTheme = themeList.Item(1)
Call avSetEditable(pmxDoc, theTheme, true)
'
' ---Delete all features in the theme
Call avRemoveRecord(pmxDoc, theTheme, -2)
Call avSetEditable(pmxDoc, theTheme, false)
19. How to delete the selected features in a theme
'
Dim pMxApp As IMxApplication
Dim pmxDoc As IMxDocument
Dim pActiveView As IActiveView
Dim pMap As IMap
Dim themeList As New Collection
Dim theTheme As Variant
'
' ---Get the active view
Call avGetActiveDoc(pMxApp, pmxDoc, pActiveView, pMap)
'
' ---Get a list of only the feature layers
Call avGetThemes(pmxDoc, 4, themeList)
'
' ---Extract the first theme in the list
theTheme = themeList.Item(1)
Call avSetEditable(pmxDoc, theTheme, true)
'
' ---Delete the selected features in the theme, if there are
' ---no selected features no error will be generated and the
' ---theme will be left as is
Call avRemoveRecord(pmxDoc, theTheme, -1)
Call avSetEditable(pmxDoc, theTheme, false)
20. How to delete a specific feature in a theme
'
Dim pMxApp As IMxApplication
Dim pmxDoc As IMxDocument
Dim pActiveView As IActiveView
Dim pMap As IMap
Dim themeList As New Collection
Dim theTheme As Variant
Dim rec As Long
'
' ---Get the active view
Call avGetActiveDoc(pMxApp, pmxDoc, pActiveView, pMap)
'
' ---Get a list of only the feature layers
Call avGetThemes(pmxDoc, 4, themeList)
'
' ---Extract the first theme in the list
theTheme = themeList.Item(1)
Call avSetEditable(pmxDoc, theTheme, true)
'
' ---Delete the specific record in the theme
Call avRemoveRecord(pmxDoc, theTheme, rec)
Call avSetEditable(pmxDoc, theTheme, false)
21. How to select all records in a table
'
Dim pMxApp As IMxApplication
Dim pmxDoc As IMxDocument
Dim pActiveView As IActiveView
Dim pMap As IMap
Dim themeList As New Collection
Dim theTable As Variant
Dim sel As ISelectionSet
'
' ---Get the active view
Call avGetActiveDoc(pMxApp, pmxDoc, pActiveView, pMap)
'
' ---Get a list of only the tables
Call avGetThemes(pmxDoc, 2, themeList)
'
' ---Extract the first table in the list
theTable = themeList.Item(1)
'
' ---Select all records in the table
Call avSetAll(pmxDoc, theTable, sel)
Call avUpdateSelection(pmxDoc, theTable)
'
' ---Update the display to reflect the new selection
Call avGetDisplayFlush
22. How to select a specific record in a table
'
Dim pMxApp As IMxApplication
Dim pmxDoc As IMxDocument
Dim pActiveView As IActiveView
Dim pMap As IMap
Dim themeList As New Collection
Dim theTable As Variant
Dim rec As Long
'
' ---Get the active view
Call avGetActiveDoc(pMxApp, pmxDoc, pActiveView, pMap)
'
' ---Get a list of only the tables
Call avGetThemes(pmxDoc, 2, themeList)
'
' ---Extract the first table in the list
theTable = themeList.Item(1)
'
' ---Clear the current selection set for the table
Call avClearSelection(pmxDoc, theTable)
Call avUpdateSelection(pmxDoc, theTable)
'
' ---Update the display to reflect the new selection
Call avGetDisplayFlush
'
' ---Select the specific record, 12, in the table
Call avBitmapSet(pmxDoc, theTable, rec)
Call avUpdateSelection(pmxDoc, theTable)
'
' ---Update the display to reflect the new selection
Call avGetDisplayFlush
23. How to delete all records in a table
'
Dim pMxApp As IMxApplication
Dim pmxDoc As IMxDocument
Dim pActiveView As IActiveView
Dim pMap As IMap
Dim themeList As New Collection
Dim theTable As Variant
'
' ---Get the active view
Call avGetActiveDoc(pMxApp, pmxDoc, pActiveView, pMap)
'
' ---Get a list of only the tables
Call avGetThemes(pmxDoc, 2, themeList)
'
' ---Extract the first table in the list
theTable = themeList.Item(1)
Call avSetEditable(pmxDoc, theTable, true)
'
' ---Delete all records in the table
Call avRemoveRecord(pmxDoc, theTable, -2)
Call avSetEditable(pmxDoc, theTable, false)
24. How to delete the selected records in a table
'
Dim pMxApp As IMxApplication
Dim pmxDoc As IMxDocument
Dim pActiveView As IActiveView
Dim pMap As IMap
Dim themeList As New Collection
Dim theTable As Variant
'
' ---Get the active view
Call avGetActiveDoc(pMxApp, pmxDoc, pActiveView, pMap)
'
' ---Get a list of only the tables
Call avGetThemes(pmxDoc, 2, themeList)
'
' ---Extract the first table in the list
theTable = themeList.Item(1)
Call avSetEditable(pmxDoc, theTable, true)
'
' ---Delete the selected records in the table, if there are
' ---no selected records no error will be generated and the
' ---table will be left as is
Call avRemoveRecord(pmxDoc, theTable, -1)
Call avSetEditable(pmxDoc, theTable, false)
25. How to delete a specific record in a table
'
Dim pMxApp As IMxApplication
Dim pmxDoc As IMxDocument
Dim pActiveView As IActiveView
Dim pMap As IMap
Dim themeList As New Collection
Dim theTable As Variant
Dim rec As Long
'
' ---Get the active view
Call avGetActiveDoc(pMxApp, pmxDoc, pActiveView, pMap)
'
' ---Get a list of only the tables
Call avGetThemes(pmxDoc, 2, themeList)
'
' ---Extract the first table in the list
theTable = themeList.Item(1)
Call avSetEditable(pmxDoc, theTable, true)
'
' ---Delete the specific record in the table
Call avRemoveRecord(pmxDoc, theTable, rec)
Call avSetEditable(pmxDoc, theTable, false)
26. How to uniquely classify a theme
'
Dim pMxApp As IMxApplication
Dim pmxDoc As IMxDocument
Dim pActiveView As IActiveView
Dim pMap As IMap
Dim themeList As New Collection
Dim theTheme As Variant
'
' ---Get the active view
Call avGetActiveDoc(pMxApp, pmxDoc, pActiveView, pMap)
'
' ---Get a list of only the feature layers
Call avGetThemes(pmxDoc, 4, themeList)
'
' ---Extract the first theme in the list
theTheme = themeList.Item(1)
'
' ---Uniquely classify the theme on the TYPE field specifying to not
' ---draw features that have not been assigned a value for the TYPE
' ---field
Call avUnique(pmxDoc, theTheme, "TYPE", False)
27. How to store a value in a specific field for a specific record in a theme
'
Dim pMxApp As IMxApplication
Dim pmxDoc As IMxDocument
Dim pActiveView As IActiveView
Dim pMap As IMap
'
' ---Get the active view
Call avGetActiveDoc(pMxApp, pmxDoc, pActiveView, pMap)
'
' ---Get the attribute table for the L_0ln theme
Call avGetFTab(pmxDoc, "L_0ln", theFTab, pFeatCls, pLayer)
Call avSetEditable(pmxDoc, "L_0ln", true)
Call avSetValue(pmxDoc, "L_0ln", col1, rec, 24)
Call avSetValue(pmxDoc, "L_0ln", col2, rec, 100)
Call avSetValue(pmxDoc, "L_0ln", col2, rec, "StoreRec")
Call avSetEditable(pmxDoc, "L_0ln", false)
28. How to store a value in a specific field for a specific record in a table
'
Dim pMxApp As IMxApplication
Dim pmxDoc As IMxDocument
Dim pActiveView As IActiveView
Dim pMap As IMap
'
' ---Get the active view
Call avGetActiveDoc(pMxApp, pmxDoc, pActiveView, pMap)
'
' ---Get the virtual table for a table called aTable
Call avGetVTab(pmxDoc, "aTable", theVTab)
Call avSetEditable(pmxDoc, "aTable", true)
Call avSetValue(pmxDoc, "aTable", col1, rec, 24)
Call avSetValue(pmxDoc, "aTable", col2, rec, 100)
Call avSetValue(pmxDoc, "aTable", col2, rec, "StoreRec")
Call avSetEditable(pmxDoc, "aTable", false)
29. How to cycle through all features in a theme
'
Dim pMxApp As IMxApplication
Dim pmxDoc As IMxDocument
Dim pActiveView As IActiveView
Dim pMap As IMap
'
' ---Get the active view
Call avGetActiveDoc(pMxApp, pmxDoc, pActiveView, pMap)
'
' ---Get the attribute table for the L_0ln theme
Call avGetFTab(pmxDoc, "L_0ln", theFTab, pFeatCls, pLayer)
Call avGetFTabIDs(pmxDoc, "L_0ln", recList)
total = 0#
30. How to cycle through the selected features for a theme
'
Dim pMxApp As IMxApplication
Dim pmxDoc As IMxDocument
Dim pActiveView As
IActiveView
Dim pMap As IMap
Dim theFTab As IFields
Dim pFeatCls As
IFeatureClass
Dim pLayer As
IFeatureLayer
Dim col As Long
Dim totalVal As Double
Dim sel As ISelectionSet
Dim totalRecs As Long,
xyzRec As Long
Dim aMessage As Variant
Dim pFeatureCursor As
IFeatureCursor
Dim pFeat As IFeature
Dim aValue As Double
'
' ---Get the active
view
Call avGetActiveDoc(pMxApp, pmxDoc,
pActiveView, pMap)
'
' ---Get the attribute
table for the L_0ln theme
Call avGetFTab(pmxDoc,
"L_0ln", theFTab, pFeatCls, pLayer)
'
' ---Define the field
to be processed
col
= theFTab.FindField("Map")
'
' ---Initialize the
total value
totalVal
= 0#
'
' ---Get the selected
set for the theme
Call avGetSelection(pmxDoc,
"L_0ln", sel)
'
' ---Define the
number of selected features
totalRecs
= sel.Count
'
' ---Make sure there
are selected features to process
If (totalRecs > 0)
Then
'
' ---Initialize the
progress bar
xyzRec
= 0
aMessage
= "Processing selected features, Be right back..."
Call RunProgress(xyzRec,
totalRecs, aMessage)
'
' ---Get an
IFeatureCursor for the selection set
sel.Search
Nothing, False, pFeatureCursor
'
' ---Get the first feature
in the cursor
Set pFeat =
pFeatureCursor.NextFeature
'
' ---Cycle thru the
cursor adding the value of the attribute
' ---for a feature to
the total
Do While Not pFeat Is Nothing
'
' ---Extract the
attribute value for the feature
aValue
= pFeat.Value(col)
'
' ---Add the value to
the total value
totalVal
= totalVal + aValue
'
' ---Increment the
progress bar
xyzRec
= xyzRec + 1
Call RunProgress(xyzRec,
totalRecs, aMessage)
'
' ---Get the next
feature in the cursor
Set pFeat =
pFeatureCursor.NextFeature
'
' ---Clear the progress
bar
Call RunProgress(-1,
totalRecs, aMessage)
End If
31. How to programmatically create a shapefile and add it to the view
'
Dim pMxApp As IMxApplication
Dim pmxDoc As IMxDocument
Dim pActiveView As IActiveView
Dim pMap As IMap
Dim sThmName As String, sPthName As String
Dim PTheme As IFeatureLayer
Dim aIndex As Long
Dim iok As Integer
Dim attList As New Collection
Dim iRec As Long
Dim theFTab As IFields
Dim pFeatCls As IFeatureClass
Dim pLayer As IFeatureLayer
Dim pLineX As IPolyline
Dim aField As Long
Dim usrRect As IPolygon
Dim newRect As IEnvelope
'
' ---Get the active view
Call avGetActiveDoc(pMxApp, pmxDoc, pActiveView, pMap)
'
' ---Define the name of the shapefile to be created
sThmName = "L_poly.shp"
'
' ---Define the full pathname of the shapefile
sPthName = "c:\temp\" + sThmName
'
' ---Create a polyline shapefile
Set PTheme = avFTabMakeNew(sPthName, "POLYLINE")
'
' ---Check if the shapefile was created, the shapefile will not be
' ---created if it exists on disk or if there is a permission issue
If (PTheme Is Nothing) Then
'
' ---The shape file was not created, this is due to either:
' ---a. the shapefile already exists on disk, or
' ---b. a permission problem does not allow the shapefile to
' --- be created
'
' ---Check if the shapefile exists on disk
If (avFileExists(sPthName)) Then
'
' ---Check if the shapefile exists in the view (map)
aIndex = avFindDoc(sThmName)
'
' ---Handle case when the shapefile was found in the view (map)
If (aIndex <> -1) Then
' ---Remove the shapefile from the view (map)
Call avRemoveDoc(sThmName)
End If
'
' ---Delete the shapefile from disk
iok = avDeleteDS(sPthName)
'
' ---Check if the shapefile was deleted without error
If (iok = 0) Then
'
' ---Create the polyline shapefile with the knowledge
' ---that the shapefile no longer exists on disk
Set PTheme = avFTabMakeNew(sPthName, "POLYLINE")
'
' ---Handle case when shapefile was not deleted
Else
Call avMsgBox("Error deleting shapefile")
End If
'
' ---Handle case when there is a permission problem which does
' ---not allow the shapefile to be created
Else
Call avMsgBox("Shapefile: " + sThmName + " does not exist" + _
Chr(13) + "and could not create the shapefile")
End If
End If
'
' ---Handle case when the shapefile was created
If (Not PTheme Is Nothing) Then
'
' ---Add the shapefile to the map
iok = avAddDoc(PTheme)
'
' ---Create a collection (list) to contain the attributes
Call CreateList(attList)
'
' ---Create the various attributes
Set pAtt1 = avFieldMake("A_Char", "CHAR", 40, 0)
attList.Add pAtt1
Set pAtt2 = avFieldMake("A_VChar", "VCHAR", 20, 0)
attList.Add pAtt2
Set pAtt3 = avFieldMake("A_Integer", "SHORT", 4, 0)
attList.Add pAtt3
Set pAtt4 = avFieldMake("A_Long", "LONG", 8, 0)
attList.Add pAtt4
Set pAtt5 = avFieldMake("A_Float", "FLOAT", 8, 2)
attList.Add pAtt5
Set pAtt6 = avFieldMake("A_Decimal", "DECIMAL", 8, 2)
attList.Add pAtt6
Set pAtt7 = avFieldMake("A_Double", "DOUBLE", 14, 6)
attList.Add pAtt7
'
' ---Add the attributes into the theme, this must be done with
' ---the theme not being editable, if the theme is editable it
' ---will be made to be not editable and any edits that were made
' ---to the theme will be saved
iok = avAddFields(pmxDoc, sThmName, attList)
'
' ---Make the shapefile editable
Call avSetEditable(pmxDoc, sThmName, True)
'
' ---Start an operation that will be added to the Undo list
Call avStartOperation
'
' ---Add a record to the shapefile, this is a new feature that
' ---has been added to the shapefile
iRec = avAddRecord(pmxDoc, sThmName)
'
' ---Get the attribute table
Call avGetFTab(pmxDoc, sThmName, theFTab, pFeatCls, pLayer)
'
' ---Create a line that will represent the geometry of the
' ---new feature in the shapefile
Set pLineX = avPolyline2Pt(20000#, 20000#, 30000#, 25000#)
'
' ---Store some values in some of the attributes
aField = theFTab.FindField("A_Char")
Call avSetValue(pmxDoc, sThmName, aField, iRec, "Sample Text")
aField = theFTab.FindField("A_Double")
Call avSetValue(pmxDoc, sThmName, aField, iRec, 1234.9876)
'
' ---Store the geometry for the new feature, avSetValueG will write
' ---the record to disk so we do not need to call avSetValue using
' ---the StoreRec keyword (see samples 23 and 24)
aField = theFTab.FindField("SHAPE")
Call avSetValueG(pmxDoc, sThmName, aField, iRec, pLineX)
'
' ---Redraw the theme
Call avThemeInvalidate(pmxDoc, sThmName, True)
'
' ---Stop the operation so that the operation consists of
' ---adding a single feature, note that the editor will be
' ---in an edit state so that the {Edit} [Undo] command can
' ---be utilized, if desired. If the Edit menu item is
' ---selected, the Undo Add Feature sub menu item will appear
Call avStopOperation("Add Feature")
'
' ---Change the view so that the feature can be seen by defining
' ---the extent of the view explicitly
Set usrRect = avRectMakeXY(10000#, 12000#, 40000#, 32000#)
Call ChangeView(pmxDoc, 3, 1#, 0#, 0#, usrRect, iok, newRect)
End If
32. How to prompt the user for the name of a shapefile and add it to the view
'
Dim pMxApp As IMxApplication
Dim pmxDoc As IMxDocument
Dim pActiveView As IActiveView
Dim pMap As IMap
Dim pFieldsEdit As IFieldsEdit
Dim pFieldEdit As IFieldEdit
Dim pSR As ISpatialReference
Dim pGeomDef As IGeometryDef
Dim pGeomDefEdit As IGeometryDefEdit
Dim pAtt1 As IFieldEdit
Dim pAtt2 As IFieldEdit
Dim pAtt3 As IFieldEdit
Dim pAtt4 As IFieldEdit
Dim pAtt5 As IFieldEdit
Dim pAtt6 As IFieldEdit
Dim pAtt7 As IFieldEdit
Dim aDefName As String
Dim aMessage As String
Dim pOutFeatureClass As IFeatureClass
Dim aMsg, aTitle2 As String
Dim linesFTab As IFields
Dim pFeatureClass As IFeatureClass
Dim aLayer As IFeatureLayer
'
' ---Handle any errors that may occur
On Error GoTo Errorhandler
'
' ---Get the active view
Call avGetActiveDoc(pMxApp, pmxDoc, pActiveView, pMap)
'
' ---Step 1 : Create the OID and SHAPE fields using standard ArcObjects
' --- coding style
'
' ---Define the object ID field, OID
Set pFieldsEdit = New Fields
Set pFieldEdit = New Field
With pFieldEdit
.Name = "OID"
.Type = esriFieldTypeOID
.AliasName = "Object ID"
.IsNullable = False
End With
pFieldsEdit.AddField pFieldEdit
'
' ---Assign the spatial reference
Set pSR = New UnknownCoordinateSystem
pSR.SetDomain -9999999999#, 9999999999#, -9999999999#, 9999999999#
pSR.SetFalseOriginAndUnits 0, 0, 100000#
'
' ---Define the geometry object for the shape field
Set pGeomDef = New GeometryDef
Set pGeomDefEdit = pGeomDef
With pGeomDefEdit
' ---Specify that the shapefile will contain polylines
.GeometryType = esriGeometryPolyline
.GridCount = 1
.GridSize(0) = 10
.AvgNumPoints = 2
' ---Specify that the shapefile does not contain M values
.HasM = False
' ---Specify that the shapefile does not contain Z values
.HasZ = False
' ---Assign the spatial reference to the shapefile geometry
Set .SpatialReference = pSR
End With
'
' ---Polyline Shape Field
Set pFieldEdit = New Field
With pFieldEdit
.Name = "Shape"
.Type = esriFieldTypeGeometry
.IsNullable = True
.Editable = True
.AliasName = "Shape"
Set .GeometryDef = pGeomDef
End With
pFieldsEdit.AddField pFieldEdit
'
' ---Step 2 : Create the various attributes using Avenue Wraps
'
Set pAtt1 = avFieldMake("A_Char", "CHAR", 40, 0)
pFieldsEdit.AddField pAtt1
Set pAtt2 = avFieldMake("A_VChar", "VCHAR", 20, 0)
pFieldsEdit.AddField pAtt2
Set pAtt3 = avFieldMake("A_Integer", "SHORT", 4, 0)
pFieldsEdit.AddField pAtt3
Set pAtt4 = avFieldMake("A_Long", "LONG", 8, 0)
pFieldsEdit.AddField pAtt4
Set pAtt5 = avFieldMake("A_Float", "FLOAT", 8, 2)
pFieldsEdit.AddField pAtt5
Set pAtt6 = avFieldMake("A_Decimal", "DECIMAL", 8, 2)
pFieldsEdit.AddField pAtt6
Set pAtt7 = avFieldMake("A_Double", "DOUBLE", 14, 6)
pFieldsEdit.AddField pAtt7
'
' ---Step 3 : Prompt the user for the name of the shapefile
'
' ---Define the default shapefile filename (when the .shp extension
' ---is included the Save As Type drop-down will only include the
' ---Shapefile option, if the .shp extension is not included in the
' ---name the Shapefile and Personal Geodatabases options will appear,
' ---if the .mdb extension is included the default Save As Type option
' ---will be a personal geodatabase so that it is possible to create
' ---a personal geodatabase with the CreateNewShapefile function)
aDefName = "LinShape.shp"
'
' ---Define the file dialog message box title (caption)
aMessage = "Enter the name of the Shapefile " + _
"to contain Lines"
'
' ---Create a new Polyline Shapefile prompting the user for a name
' ---using a standard ArcObjects dialog box
Set pOutFeatureClass = CreateNewShapefile(pFieldsEdit, _
esriGeometryPolyline, _
aDefName, aMessage)
'
' ---Check if the command has been canceled by examining the
' ---value of the Avenue Wraps property Error
If (avwraps.Error = 1) Then
' ---User has canceled the command, our work is done
Exit Sub
End If
'
' ---When the shapefile has been created without error, it will be
' ---added to the map, if an error was detected the FeatureClass
' ---object will be set to NOTHING
'
' ---Check if any problems were detected
If pOutFeatureClass Is Nothing Then
aMsg = "Error creating new Shapefile, check folder permissions."
aTitle2 = "Create Shapefile Error"
iok = avMsgBoxF(aMsg, 48, aTitle2)
Exit Sub
'
' ---Shapefile created properly
Else
' ---Get the name of the shapefile
theTheme = pOutFeatureClass.AliasName
End If
'
' ---Get the attribute table (FTab) for the theme
Call avGetFTab(pmxDoc, theTheme, _
linesFTab, pFeatureClass, aLayer)
'
' ---Our work is done
Exit Sub
'
' ---Handle any errors that were detected
Errorhandler:
'
' ---Display the detected error
Call avMsgBox("Error " & Err.Number & " - " & Err.Description & _
Chr(13) & "Subroutine: Prompt4Shapefile")
33. How to programmatically create a table and add it to the view
'
Dim pMxApp As IMxApplication
Dim pmxDoc As IMxDocument
Dim pActiveView As IActiveView
Dim pMap As IMap
Dim sTblName As String, sTblPthName As String
Dim pTable As ITable
Dim aIndex As Long
Dim iok As Integer
Dim iRec As Long
Dim pFld1 As IFieldEdit
Dim pFld2 As IFieldEdit
Dim pFld3 As IFieldEdit
Dim fldList As New Collection
Dim theVTab As IFields
Dim col As Long, nrec As Long
Dim sel As ISelectionSet
'
' ---Get the active view
Call avGetActiveDoc(pMxApp, pmxDoc, pActiveView, pMap)
'
' ---Define the name of the table to be created
sTblName = "table1.dbf"
'
' ---Define the full pathname of the table
sTblPthName = "c:\temp\" + sTblName
'
' ---Create a dBase table
Set pTable = avVTabMakeNew(sTblPthName, "dbase")
'
' ---Check if the table was created, the table will not be
' ---created if it exists on disk or if there is a permission issue
If (pTable Is Nothing) Then
'
' ---The table was not created, this is due to either:
' ---a. the table already exists on disk, or
' ---b. a permission problem does not allow the table to
' --- be created
'
' ---Check if the table exists on disk
If (avFileExists(sTblPthName)) Then
'
' ---Check if the table exists in the view (map)
aIndex = avFindDoc(sTblName)
'
' ---Handle case when the table was found in the view (map)
If (aIndex <> -1) Then
' ---Remove the table from the map
Call avRemoveDoc(sTblName)
End If
'
' ---Delete the table from disk
iok = avDeleteDS(sTblPthName)
'
' ---Check if the table was deleted without error
If (iok = 0) Then
'
' ---Create the table with the knowledge
' ---that the table no longer exists on disk
Set pTable = avVTabMakeNew(sTblPthName, "dbase")
'
' ---Handle case when table was not deleted
Else
Call avMsgBox("Error deleting table")
End If
'
' ---Handle case when there is a permission problem which does
' ---not allow the table to be created
Else
Call avMsgBox("Table: " + sTblName + " does not exist" + _
Chr(13) + "and could not create the table")
End If
End If
'
' ---Handle case when table is created
If (Not pTable Is Nothing) Then
'
' ---Add the table to the map
iok = avAddDoc(pTable)
'
' ---Perform various table operations for demonstrating purposes
'
' ---Add three records to the table
iRec = avAddRecord(pmxDoc, sTblName)
iRec = avAddRecord(pmxDoc, sTblName)
iRec = avAddRecord(pmxDoc, sTblName)
'
' ---Create three fields that will be added to the table
Set pFld1 = avFieldMake("StringF", "vchar", 20, 0)
Set pFld2 = avFieldMake("DoubleF", "double", 12, 4)
Set pFld3 = avFieldMake("LongF", "long", 10, 0)
'
' ---Add the fields to a list
Call CreateList(fldList)
fldList.Add pFld1
fldList.Add pFld2
fldList.Add pFld3
'
' ---Add the field list to the table
iok = avAddFields(pmxDoc, sTblName, fldList)
'
' ---Get the attribute table
Call avGetVTab(pmxDoc, sTblName, theVTab)
'
' ---Check if the table is not editable
If (Not avIsEditable(sTblName)) Then
'
' ---Make the table editable
Call avSetEditable(pmxDoc, sTblName, True)
'
' ---Check if the table is editable, if so inform user
If (avIsEditable(sTblName)) Then
Call avMsgBox("Table: " + sTblName + " is now editable")
End If
'
' ---Store a string value in the table for all three records
' ---that were added
col = theVTab.FindField("StringF")
Call avSetValue(pmxDoc, sTblName, col, 0, "test string")
Call avSetValue(pmxDoc, sTblName, col, 0, "StoreRec")
Call avSetValue(pmxDoc, sTblName, col, 1, "second string")
Call avSetValue(pmxDoc, sTblName, col, 1, "StoreRec")
Call avSetValue(pmxDoc, sTblName, col, 2, "third string")
Call avSetValue(pmxDoc, sTblName, col, 2, "StoreRec")
'
' ---Store a number value for specific records
col = theVTab.FindField("DoubleF")
Call avSetValue(pmxDoc, sTblName, col, 0, 14.3456)
Call avSetValue(pmxDoc, sTblName, col, 0, "StoreRec")
Call avSetValue(pmxDoc, sTblName, col, 1, 24.3456)
Call avSetValue(pmxDoc, sTblName, col, 1, "StoreRec")
Call avSetValue(pmxDoc, sTblName, col, 2, 34.3456)
Call avSetValue(pmxDoc, sTblName, col, 2, "StoreRec")
'
' ---Commit the modifications to disk
Call avSetEditable(pmxDoc, sTblName, False)
'
' ---Determine the number of records in the table
nrec = avGetNumRecords(pmxDoc, sTblName)
'
' ---Select all of the records in the table
Call avSetAll(pmxDoc, sTblName, sel)
'
' ---Clear the selection
Call avClearSelection(pmxDoc, sTblName)
Call avGetSelection(pmxDoc, sTblName, sel)
'
' ---Select the second and third records in the table
Call avBitmapSet(pmxDoc, sTblName, 1)
Call avBitmapSet(pmxDoc, sTblName, 2)
Call avGetSelection(pmxDoc, sTblName, sel)
'
' ---Clear the second record from the selection
Call avGetSelectionClear(pmxDoc, sTblName, 1)
'
' ---Start editing on the table
Call avSetEditable(pmxDoc, sTblName, True)
'
' ---Add 16 records to the table
iRec = avAddRecord(pmxDoc, sTblName)
iRec = avAddRecord(pmxDoc, sTblName)
iRec = avAddRecord(pmxDoc, sTblName)
iRec = avAddRecord(pmxDoc, sTblName)
iRec = avAddRecord(pmxDoc, sTblName)
iRec = avAddRecord(pmxDoc, sTblName)
iRec = avAddRecord(pmxDoc, sTblName)
iRec = avAddRecord(pmxDoc, sTblName)
iRec = avAddRecord(pmxDoc, sTblName)
iRec = avAddRecord(pmxDoc, sTblName)
iRec = avAddRecord(pmxDoc, sTblName)
iRec = avAddRecord(pmxDoc, sTblName)
iRec = avAddRecord(pmxDoc, sTblName)
iRec = avAddRecord(pmxDoc, sTblName)
iRec = avAddRecord(pmxDoc, sTblName)
iRec = avAddRecord(pmxDoc, sTblName)
'
' ---Clear the selection set for the table
Call avClearSelection(pmxDoc, sTblName)
'
' ---Select the first two records in the table
Call avBitmapSet(pmxDoc, sTblName, 0)
Call avBitmapSet(pmxDoc, sTblName, 1)
'
' ---Delete the selected records in the table
Call avRemoveRecord(pmxDoc, sTblName, -1)
'
' ---Stop editing on the table
Call avSetEditable(pmxDoc, sTblName, False)
End If
End If
34. How to cycle through all records in a table
'
Dim pMxApp As IMxApplication
Dim pmxDoc As IMxDocument
Dim pActiveView As IActiveView
Dim pMap As IMap
'
' ---Get the active view
Call avGetActiveDoc(pMxApp, pmxDoc, pActiveView, pMap)
'
' ---Get the virtual table for a table called aTable
Call avGetVTab(pmxDoc, "aTable", theVTab)
Call avGetVTabIDs(pmxDoc, "aTable", recList)
total = 0#
Call avGetTableRow(pmxDoc, "aTable", rec, pRow)
35. How to cycle through the selected features for a table
'
Dim pMxApp As IMxApplication
Dim pmxDoc As IMxDocument
Dim pActiveView As IActiveView
Dim pMap As IMap
'
' ---Get the active view
Call avGetActiveDoc(pMxApp, pmxDoc, pActiveView, pMap)
'
' ---Get the virtual table for a table called aTable
Call avGetVTab(pmxDoc, "aTable", theVTab)
Call avGetSelection(pmxDoc, "aTable", sel)
Call avGetSelectionIDs(sel, selList)
total = 0#
Call avGetTableRow(pmxDoc, "aTable", rec, pRow)
36. How to cycle through all features/rows or the selected features/rows for a layer/table using a Cursor
This sample illustrates how to process either all features/rows or
just
the selected features/rows in a layer/table. The advantage of using this
method is that if the layer has a join applied
to it the attributes that
are joined to the layer will be
accessible. Note that when a layer has a
join the field name is prefixed with the
name of the layer. For example,
if a layer called A has a field called
TEST, the field should be addressed as
A.TEST and not TEST. In addition, note that processing
features/rows using
a Cursor object is the fastest approach to
processing multiple features/rows.
'
Dim pMxApp As IMxApplication
Dim pmxDoc As IMxDocument
Dim pActiveView As IActiveView
Dim pMap As IMap
Dim aTheme1 As Variant
Dim indxPos As Long
Dim aFTab1 As IFields
Dim pFCls1 As IFeatureClass
Dim pFLyr1 As IFeatureLayer
Dim pTable As ITable
Dim sShpName1 As String,
sShpName2 As String
Dim haveLyr As Integer
Dim aList1 As New
Collection
Dim tempList As New
Collection
Dim ii As Long
Dim pDispTab As IDisplayTable
Dim sel As ISelectionSet
Dim selList()
As Long, nEle1 As Long
Dim pCursor As ICursor
'
' ---Get the active view
Call avGetActiveDoc(pMxApp, pmxDoc, pActiveView, pMap)
'
' ---Define the Layer
or Table to be processed
aTheme1 = "TestLayer"
'
' ---Determine the
index position in the TOC for the layer/table
indxPos
= avFindDoc2(aTheme1)
'
' ---Check if we have
a Layer to process
If (Not avwraps.Layer Is Nothing) Then
'
' ---Get the attribute
table for the layer
Call avGetFTab(pmxdoc,
aTheme1, aFTab1, pFCls1, pFLyr1)
'
' ---In order to access
any fields which are joined to the
' ---layer the ITable
interface must be used, otherwise only
' ---the attributes in
the layer will be found
Set pTable = pFLyr1
Set aFTab1 =
pTable.Fields
'
' ---Get the shape field
name in all uppercase characters
sShpName1 = UCase(pFCls1.ShapeFieldName)
'
' ---Define the shape
field name in the case the layer has a
' ---join applied to it
sShpName2 = aTheme1 +
"." + sShpName1
'
' ---Set flag denoting a
layer is being processed
haveLyr
= 1
'
' ---Handle case when
a Table is to be processed
Else
'
' ---Get the attribute
table for the table
Call avGetVTab(pmxdoc,
aTheme1, aFTab1)
'
' ---Get the ITable
interface
Set pTable =
avwraps.Table
'
' ---Initialize the
layer objects
Set pFCls1 = Nothing
Set pFLyr1 = Nothing
'
' ---Initialize the
shape field name
sShpName1 =
"there is no shape field name"
'
' ---Define the shape
field name in the case the table has a
' ---join applied to it
sShpName2 = aTheme1 +
"." + sShpName1
'
' ---Set flag denoting a
table is being processed
haveLyr
= 0
End If
'
' ---Get a list of
the attributes for the layer/table (for layers
' ---with a join all
fields will be included)
Call avGetFields(aFTab1, aList1)
'
' ---Remove the shape
field name from the list, accounting for
' ---the layer
containing a join (layername.shape)
Call CreateList(tempList)
For ii = 1 To aList1.Count
If ((UCase(aList1.Item(ii)) <> UCase(sShpName1)) And _
(UCase(aList1.Item(ii)) <> UCase(sShpName2))) Then
tempList.Add (aList1.Item(ii))
End If
Next
Call CopyList3(tempList, aList1)
'
' ---Get the
selection set for the layer or table using this method
' ---because it will
account for layers with a join
'
' ---Check if we have
a Layer to process
If (Not avwraps.Layer Is Nothing) Then
Set pDispTab = pFLyr1
Set pTable =
pDispTab.DisplayTable
' ---Handle case when
a Table is to be processed
Else
Set pDispTab =
avwraps.Table
End If
'
' ---Get the selected
rows from the IDisplayTable object
Set sel =
pDispTab.DisplaySelectionSet
'
' ---Get an ICursor
object for either the selected set or the
' ---entire layer or
table
'
' ---Determine number
of selected features/rows to be processed
If (sel.Count > 0)
Then
Call avGetSelectionIDs2(sel,
selList)
' ---Get an ICursor
object for the selection set
sel.Search
Nothing, False, pCursor
' ---Determine the
number of elements to be processed
nEle1 = UBound(selList)
'
' ---Handle case when
the entire layer/table is to be checked
Else
' ---Get an ICursor
object for the layer/table
Set pCursor = pTable.Search(Nothing, False)
' ---Determine the
number of elements to be processed
nEle1 = avGetNumRecords(pmxdoc,
aTheme1)
End If
'
' ---Initialize the
progress bar
xyzRec
= 0
totalRecs
= nEle1
aMessage
= "Processing features in " + CStr(aTheme1) + "..."
Call RunProgress(xyzRec, totalRecs,
aMessage)
'
' ---Get the first
row found in the ICursor
Set pRow =
pCursor.NextRow
'
' ---Loop until we
have run out of rows
Do While Not pRow Is Nothing
'
' ---Increment the
progress bar
xyzRec
= xyzRec + 1
Call RunProgress(xyzRec,
totalRecs, aMessage)
'
' ---Get the next row
found in the selection
Set pRow = pCursor.NextRow
'
' ---Clear the
progress bar
Call RunProgress(-1, totalRecs,
aMessage)
37. How to determine the type of a field
'
Dim pMxApp As IMxApplication
Dim pmxDoc As IMxDocument
Dim pActiveView As IActiveView
Dim pMap As IMap
Dim pField As iField
Dim fldType As esriFieldType
'
' ---Get the active view
Call avGetActiveDoc(pMxApp, pmxDoc, pActiveView, pMap)
'
' ---Get the attribute table for the L_0ln theme
Call avGetFTab(pmxDoc, "L_0ln", theFTab, pFeatCls, pLayer)
'
' ---Get the field interface for the field
Set pField = theFTab.Field(col)
'
' ---Determine the field type
' ---fldType = 0 : Small Integer
' ---fldType = 1 : Long Integer
' ---fldType = 2 : Single-precision float
' ---fldType = 3 : Double-precision float
' ---fldType = 4 : String
' ---fldType = 5 : Date
' ---fldType = 6 : Long Integer denoting the OID
' ---fldType = 7 : Geometry
' ---fldType = 8 : Blob
fldType = avFieldGetType(pField)
38. How to get the unique values of a field for a theme or a table
The following is a copy of a subroutine which appears in the
Avenue
Wraps library of procedures. The variables ugLayerStrg, ugLayer and
ugTable are global variables, which are used by
Avenue Wraps, and are
used to keep track of the last layer or
table that was processed.
Avenue Wraps users can simply make a call to the avGetUniqueValues
procedure
with the appropriate arguments. However, by examining the code below,
the reader can see how it is important to
keep track of whether a layer
or a table is being processed because
different interfaces are required
depending upon the type (layer or table).
Option Explicit
' 1 2 3 4 5 6 7 8
'
' * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * *
' * *
' * Name: avGetUniqueValues File Name: avunqval.bas *
' *
*
' * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * *
' *
*
' * PURPOSE:
GET A LIST OF UNIQUE VALUES FOR A FIELD IN A THEME OR *
' * A TABLE
*
' * *
' * GIVEN:
pmxDoc = the active view *
' * theTheme = name of the theme or
table to be processed *
' * aField = name of the field to be processed *
' *
*
' * RETURN:
aList = list of unique values
for the specified *
' * field *
' * *
' * Dim pmxDoc As IMxDocument *
' * Dim theTheme As Variant *
' * Dim aField As String *
' * Dim aList As New Collection *
' *
*
' * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * *
'
Public Sub avGetUniqueValues(pmxDoc As
IMxDocument, _
theTheme, aField, aList)
'
Dim aIndex As Long
Dim theFTab As IFields
Dim pFeatCls As
IFeatureClass
Dim pFLyr As
IFeatureLayer
Dim col As Long, nUniq As
Long
Dim pFeatureCursor As
IFeatureCursor
Dim pFeature As IFeature
Dim aVal As Variant
Dim unqValues()
As Variant
Dim yesFound As Boolean
Dim ii As Long
Dim pStTab As
IStandaloneTable
Dim pTable As ITable
Dim theVTab As IFields
Dim pCursor As ICursor
Dim pRow As IRow
'
' ---Initialize the
list of unique values to be passed back
Call CreateList(aList)
'
' ---Check if a valid
attribute has been specified
If (Not IsNull(aField)) Then
'
' ---Validity check
If (theTheme <>
" ") Then
'
' ---Check if the
theme or table passed in does not match the
' ---global variable
for the last theme or table processed
If (ugLayerStrg
<> UCase(theTheme)) Then
' ---Do a full
search because a new theme or table is
' ---to be processed
aIndex = avFindDoc(theTheme)
' ---The global
variable matches the theme or table passed in
' ---we are working
on the same theme or table last processed
Else
' ---Set flag we
have a valid theme or table
aIndex = 1
End If
'
' ---Check if we can
process the theme or table
If (aIndex <>
-1) Then
'
' ---Check if a
layer is to be processed
If (Not ugLayer Is Nothing) Then
'
' ---Get the attribute table for the theme
Call avGetFTab(pmxDoc,
theTheme, theFTab, pFeatCls, pFLyr)
'
' ---Get the
field index for the attribute to be processed
col = theFTab.FindField(aField)
'
' ---Make sure
the field was found
If (col
<> -1) Then
'
'
---Initialize the number of unique values found
nUniq = 0
'
' ---Get a
cursor of the features in the map layer
Set pFeatureCursor
= pFeatCls.Search(Nothing, False)
'
' ---Get the
first feature found in the map layer
Set
pFeature = pFeatureCursor.NextFeature
'
' ---Loop
until we have run out of features
Do While
Not pFeature Is Nothing
'
' ---Get
the value for the feature
aVal = pFeature.Value(col)
'
'
---Check if the first value is being processed
If
(nUniq = 0) Then
'
' ---Increment the number of
unique values
nUniq = nUniq + 1
'
'
---Resize the array preserve the existing values
ReDim Preserve unqValues(nUniq)
'
' ---Store the unique value
unqValues(nUniq) = aVal
'
'
---Check if this value has already been added, if not
' ---add
it to the array
Else
yesFound = False
For
ii = 1 To nUniq
If unqValues(ii) = aVal Then
yesFound = True
Exit For
End If
Next
If
(Not yesFound) Then
nUniq = nUniq + 1
ReDim Preserve unqValues(nUniq)
unqValues(nUniq) = aVal
End
If
End If
'
' ---Get
the next feature found in the map layer
Set
pFeature = pFeatureCursor.NextFeature
End If
'
' ---Handle case
of processing a table
Else
'
' ---Get the
table
Set pStTab =
ugTable
Set pTable =
pStTab.Table
'
' ---Get the
list of attributes for the table
Set theVTab =
pTable.fields
'
' ---Get the
field index for the attribute to be processed
col =
theVTab.FindField(aField)
'
' ---Make sure
the field was found
If (col
<> -1) Then
'
'
---Initialize the number of unique values found
nUniq = 0
'
' ---Get a
cursor of the rows in the table
Set
pCursor = pTable.Search(Nothing, False)
'
' ---Get the
first row found in the table
Set pRow =
pCursor.NextRow
'
' ---Loop
until we have run out of rows
Do While
Not pRow Is Nothing
'
' ---Get
the value for the feature
aVal =
pRow.Value(col)
'
'
---Check if the first value is being processed
If (nUniq = 0) Then
'
'
---Increment the number of unique values
nUniq = nUniq + 1
'
'
---Resize the array preserve the existing values
ReDim Preserve unqValues(nUniq)
'
'
---Store the unique value
unqValues(nUniq) = aVal
'
'
---Check if this value has already been added, if not
' ---add
it to the array
Else
yesFound = False
For
ii = 1 To nUniq
If unqValues(ii) = aVal Then
yesFound = True
Exit For
End If
Next
If
(Not yesFound) Then
nUniq = nUniq + 1
ReDim Preserve unqValues(nUniq)
unqValues(nUniq) = aVal
End If
End If
'
' ---Get
the next row found in the table
Set
pRow = pCursor.NextRow
End If
End If
'
' ---Copy the values
into the list to be passed back, if any
If (nUniq >
0) Then
For ii = 1 To
nUniq
aList.Add
(unqValues(ii))
Next
End If
End If
End If
End If
'
End Sub
39. How to determine the type of a theme
Dim pMxApp As IMxApplication
Dim pmxDoc As IMxDocument
Dim pActiveView As
IActiveView
Dim pMap As IMap
Dim theTheme As Variant
'
' ---Get the active view
Call avGetActiveDoc(pMxApp,
pmxDoc, pActiveView, pMap)
'
' ---Find the theme to be examined
theTheme = FindTheme(pMap,
"Theme1")
'
' ---Use the Avenue Wraps workspace description
property
' ---to determine the type of theme we have
If
(UCase(avwraps.WrkSpcDesc) = "ARCINFO WORKSPACE") Then
MsgBox
"An ArcInfo Workspace was found."
'
Elseif(UCase(avwraps.WrkSpcDesc)
= "PC ARCINFO WORKSPACE") Then
MsgBox "A PC ArcInfo Workspace was
found."
'
Elseif(UCase(avwraps.WrkSpcDesc)
= "CAD WORKSPACE") Then
MsgBox "A CAD drawing was found."
'
Elseif(UCase(avwraps.WrkSpcDesc)
= "PERSONAL GEODATABASE") Then
MsgBox "A Personal GeoDatabase was
found."
'
Elseif(UCase(avwraps.WrkSpcDesc)
= "SHAPEFILES") Then
MsgBox "A Shapefile was found."
'
Elseif(UCase(avwraps.WrkSpcDesc)
= "UNKNOWN") Then
MsgBox "The theme does not exist or it
is not a feature layer."
'
End If
40. How to write and read data to an ASCII file - Example 1
'
Dim aFileName As String, aString1 As String, aString2 As String
Dim cedFile
Dim k As Integer, iok As Integer
'
' ---Define a temporary filename
aFileName = "c:\temp\l_zxcv"
'
' ---Perform two passes
' ---Pass 1 write two lines of data to a temporary file
' ---Pass 2 read two lines of data from the temporary file
For k = 1 To 2
'
' ---Open the file for reading
Set cedFile = avLineFileMake(aFileName, "READ")
'
' ---Check if the file does not exist
If (cedFile Is Nothing) Then
'
' ---Open the file for writing
Set cedFile = avLineFileMake(aFileName, "WRITE")
'
' ---Write two lines of data to the temporary file
cedFile.WriteLine ("First data line")
cedFile.WriteLine ("Second data line")
'
' ---Handle case when the file exists
Else
'
' ---Read the first two lines of data in the file
aString1 = cedFile.ReadLine
aString2 = cedFile.ReadLine
End If
'
' ---Close the temporary file
Call avLineFileClose(cedFile)
Next k
'
' ---Check if the temporary file exists
If (avFileExists(aFileName)) Then
'
' ---Delete the temporary file
iok = avFileDelete(aFileName)
End If
41. How to write and read data to an ASCII file - Example 2
'
Dim aFileName As String
Dim cedFile
Dim totalRecs As Long, xyzRec As Long
Dim iLinLeft As Long, nChrs As Long
Dim aMsg As Variant
Dim buf1 As String, buf2 As String
Dim tmpStrng As String, theDChr As String
Dim xyzTokens As New Collection
Dim datalineItems As Long
'
' ---In this example, we are opening and reading an ASCII file that must
' ---have at least two items per data line and may have:
' ---Comment lines, which are denoted with a slash and asterisk (/*) in
' --- columns 1 and 2, that should be disregarded
' ---Blank lines, data lines containing no data
' ---Data items separated by either a comma, blank space or a tab
'
' ---Set the file name and open the file
aFileName = "c:\temp\l_zxcv"
Set cedFile = avLineFileMake(aFileName, "READ")
'
' ---Find the number of bytes in the file this is used to determine
' ---the size of the file
totalRecs = FileLen(aFileName)
'
' ---Initialize number of lines in the file read
xyzRec = 0
'
' ---Initialize status area and display message
aMsg = "
Call RunProgress(xyzRec, totalRecs, aMsg)
'
' ---Cycle thru the file skipping over comment lines, a valid
' ---data line will be a non-comment line
For iLinLeft = 1 To totalRecs
'
' ---Check if the end of file encountered
If (cedFile.AtEndOfStream) Then
Exit For
End If
'
' ---Grab line from input file and store in a buffer
buf1 = cedFile.ReadLine
'
' ---Increment total number of bytes read, and
' ---update the progress bar accounting for the end
' ---of line and new line characters
xyzRec = xyzRec + Len(buf1) + 2
Call RunProgress(xyzRec, totalRecs, aMsg)
'
' ---Trim any leading and/or trailing blank spaces
buf2 = Trim(buf1)
'
' ---Check if a non-comment data line was read
nChrs = Len(buf2)
If (nChrs > 1) Then
'
' ---Get the first two characters in the data line
tmpStrng = Mid(buf2, 1, 2)
'
' ---Check if a non-comment data line has been found
If (tmpStrng <> "/*") Then
'
' ---A valid data line has been found.
' ---Set flag to check for the comma delimiter
theDChr = ","
'
' ---Extract the list of items on the data line
' ---using the comma delineator character
Call avAsTokens(buf2, theDChr, "N", _
xyzTokens, datalineItems)
'
' ---Not enough items on the data line, try
' ---using the space delimiter
If (datalineItems <= 1) Then
theDChr = " "
Call avAsTokens(buf2, theDChr, "N", _
xyzTokens, datalineItems)
'
' ---Not enough items on the data line, try
' ---using the tab delimiter character
If (datalineItems <= 1) Then
theDChr = Chr(9)