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
42. How to prompt the user for File Names - Example 3
Utility Samples
43. How to create and sort a collection (list)
44. How to display a progress bar without a stop or cancel button
45. How to display a progress bar with a stop or cancel button
46. Formatting numbers as strings
47. Hot to get and format the current Date
48. Drawing Graphic Text
Legend and Classification Samples
49. How to assign a unique classification to a theme
50. How to process labels and symbols in a classification
Feature Geometry Samples
51. How to create polyline geometry from a list of coordinates
52. How to process polyline geometry
53. How to process polygon geometry
Message Box Samples
54. How to create a dialog box combining data line and combo-box items
Join and Link Samples
55. How to join a table to a theme
56. How to link a table to a theme
57. How to link two themes and zoom to the Selected Features
Graphic Elements Samples
58. How to find graphic elements in an Annotation Group layer
59. How to parse the graphic elements in the Layout View
60. How to find all of the graphic text elements in a Data View
61. How to find all of the graphic text elements in the Layout View
62. How to convert selected graphic text elements into Callouts
Printing Samples
63. How to print the current map
64. How to print the current map from the Layout View
Attribute Editing Sample
65. 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)
Call avAsTokens(buf2, theDChr, "N", _
xyzTokens, datalineItems)
End If
End If
'
' ---Handle case when enough items specified
If (datalineItems > 1) Then
'
' ---Add code to perform some action
End If
End If
End If
Next iLinLeft
'
' ---Clear the status bar area
Call RunProgress(-1, totalRecs, aMsg)
42. How to prompt the user for File Names - Example 3
'
Dim pMxApp As
IMxApplication
Dim pmxdoc As IMxDocument
Dim pActiveView As
IActiveView
Dim pMap As IMap
Dim aTitle As String
Dim theDropDown(3)
As String
Dim Labels As New Collection
Dim Defaults As New Collection
Dim typeList As New
Collection
Dim aList As New
Collection
'
' ---Handle any
errors that may occur
On Error GoTo
Errorhandler
'
' ---Get the active
view
<<<------
Call avGetActiveDoc(pMxApp, pmxdoc,
pActiveView, pMap)
'
' ---Define the
message box caption (title)
aTitle
= "Sample for Prompting for File Input"
'
' ---Define the items
to appear in the drop-down list
theDropDown(1)
= "Item Number 1"
theDropDown(2)
= "Item Number 2"
theDropDown(3)
= "Item Number 3"
'
' ---Build the list
of input parameter labels
Labels.Add ("Input File:")
Labels.Add ("Output File:")
Labels.Add ("Test
Number Value (>= 0.0):")
Labels.Add ("Choice
List Values:")
'
' ---Build the list
of default values
'
' ---Set the file
type index to be *.inp for the Input File
avwraps.
FilterIndexRead
= 9
Defaults.Add ("
")
'
' ---Set the file
type index to be *.txt for the Output File
avwraps.
FilterIndexWrite
= 5
Defaults.Add
("c:\test\o-output.txt")
'
' ---Set the default
number value to be zero
Defaults.Add
("0.0")
'
' ---Add the array of
options to the default values list
Defaults.Add
(theDropDown)
'
' ---Define the type
of data line items
' ---1 = data line
' ---2 = combo box
' ---3 = text box
with multiselect
' ---4 = same as 3
w/o the label, Item List:
' --- displayed on the left side of the
' --- dialog box (provides more room to
' --- display the items in the list)
' ---5 = data line
with read file browse
' --- icon to right of the data line
' ---6 = data line
with write file browse
' --- icon to right of the data line
typeList.Add (5)
typeList.Add (6)
typeList.Add (1)
typeList.Add (2)
'
' ---
Do While (True)
'
' ---Prompt the user for
the design parameters
Call VDBbuild("Enter
the Parameters:", aTitle, _
Labels, Defaults, typeList, aList)
'
' ---Check if the
command is to be aborted
If (aList.Count <=
0) Then
' ---Clear the status
bar area
Call avShowMsg("
")
Exit Sub
End If
'
' ---Validity checks
If (Len(Trim(aList.Item(1)))
<= 0) Then
Call avMsgBoxWarning("Invalid
Input File Name.", aTitle)
ElseIf (Not avFileExists(aList.Item(1))) Then
Call avMsgBoxWarning("Input
File Name does not exist.", aTitle)
'
ElseIf (Len(Trim(aList.Item(2))) <= 0) Then
Call avMsgBoxWarning("Invalid
Output File Name.", aTitle)
ElseIf (Not avFileExists(aList.Item(2))) Then
Call avMsgBoxWarning("Output
File Name does not exist.", aTitle)
'
ElseIf (Not (IsNumeric(aList.Item(3)))) Then
Call avMsgBoxWarning("Invalid
Number Value.", aTitle)
ElseIf (CDbl(aList.Item(3)) < 0#) Then
Call avMsgBoxWarning("Invalid
Number Value.", aTitle)
'
' ---Handle case when
all data properly specified
Else
Exit Do
End If
'
' ---Rebuild the default
values using the data specified
' ---by the user
Call CreateList(Defaults)
Defaults.Add (aList.Item(1))
Defaults.Add (aList.Item(2))
Defaults.Add (aList.Item(3))
Defaults.Add
(theDropDown)
'
' ---Make sure the
display is current
Call avGetDisplayFlush
'
Exit Sub
'
' ---Handle any
errors that were detected
Errorhandler:
'
' ---Display the
detected error
Call avMsgBox("Error "
& Err.Number & " - " & Err.Description & _
Chr(13) & "Subroutine: FilePrompting")
'
43. How to create and sort a collection (list)
'
Dim newList As New Collection
'
' ---Create a collection (list)
Call CreateList(newList)
'
' ---Add items to the collection
newList.Add("sdadqwfqwfwqf")
newList.Add("dvdvevwvwwev")
newList.Add("ttgwefwefwf")
newList.Add("asfqfef")
Call SortTwoLists(newList, Nothing, Null, True)
44. How to display a progress bar without a stop or cancel button
'
Dim j As Long, i As Long
Dim aMsg As Variant
'
' ---Define the upper limit of the loop
j = 30000
'
' ---Define the progress bar message
aMsg = “Testing progress bar...”
'
' ---Initialize the progress bar display
Call RunProgress(0, j, aMsg)
'
' ---Begin the loop and increment the progress bar
For i = 1 To j
Call RunProgress(i, j, aMsg)
Next
'
' ---Terminate the display of the progress bar
Call RunProgress(-1, j, aMsg)
45. How to display a progress bar with a stop or cancel button
'
Dim j As Long, i As Long
Dim aMsg As Variant
'
' ---Define the upper limit of the loop
j = 30000
'
' ---Define the progress bar message
aMsg = “Testing progress bar...”
'
' ---Display the cancel button
Call avShowStopButton
'
' ---Initialize the progress bar display
Call RunProgress(0, j, aMsg)
'
' ---Begin the loop and increment the progress bar
For i = 1 To j
Call RunProgress(i, j, aMsg)
' ---Check if the cancel button was selected
If (avwraps.Cancel) Then
Exit For
End If
Next
'
' ---Terminate the display of the progress bar
Call RunProgress(-1, j, aMsg)
'
' ---Inform user how may loop iterations were performed
MsgBox “Performed “ + CStr(i) + “ loops”
46. Formatting numbers as strings
'
Dim dist As Double, Z1 As Double, Z2 As Double
Dim DISstr As String, Z1str As String, Z2str As String
'
' ---Define the numbers to be converted into strings
dist = 12.987654432
Z1 = 1178.12345678
Z2 = 1473.87654321
'
' ---Convert the numbers into strings specifying the number of
' ---digits to the right of the decimal point to be 5 and 4,
' ---respectively
DISstr = Dformat(dist, 1, 5)
Z1str = Dformat(Z1, 1, 4)
Z2str = Dformat(Z2, 1, 4)
'
' ---Display the strings in the status bar
Call avShowMsg("Length=" + DISstr + _
" Z1(elv)=" + Z1str + " Z2(elv)=" + Z2str)
47. How to get
and format the current Date
'
Dim aDate As Variant, curDate As String
'
' ---Get the current date
aDate = Now
'
' ---Format the date to contain the current time and date
' ---for example: 12:
curDate = Format(aDate, "hh:m:s AMPM d mmm yyyy")
48.
Drawing Graphic Text
When creating graphic text the size of the text will be in
relationship
to the reference scale of the graphics layer that it is drawn
in. When
working with multiple annotation layers in order for the same text
size
to be used in each of the annotation layers, with the purpose of
having
the text being of equal size, each of the annotation layers must
have
the same reference scale assigned to them.
The following code will display a sample text string in the center
of
the display by setting the reference scale of the basic graphics
layer
to be equal to the current map scale.
Option Explicit
'
1
2
3
4 5
6 7
'
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * *
'
*
*
' * Name: isSAMTEX
File
Name: isSAMTEX.bas *
'
*
*
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * *
'
*
*
' * PURPOSE: DISPLAY A SAMPLE TEXT STRING
DENOTING THE CURRENT *
'
* FONT SIZE
THAT IS IN
EFFECT
*
'
*
*
' * GIVEN:
nothing
*
'
*
*
' * RETURN:
nothing
*
'
*
*
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * *
'
Public Sub isSAMTEX()
'
Dim pMxApp As IMxApplication
Dim pmxdoc As IMxDocument
Dim pActiveView As IActiveView
Dim pMap As IMap
Dim fontStrg As String
Dim currSize As Double
Dim defTFINC As Integer, defPMODE As Integer
Dim defCOLOR As Long
Dim pCurGraLyr As IGraphicsLayer
Dim pComGraLyr As ICompositeGraphicsLayer
Dim pGraLyrScl As IGraphicsLayerScale
Dim aString As String
Dim txtLen As Double, txtHT As Double
Dim pGraphic As IElement
Dim pDT As IDisplayTransformation
Dim newRect As IEnvelope
Dim ccx As Double, ccy As Double
Dim pt As IPoint
Dim aMsg As Variant
'
' ---Get the active
view
<<<------
Call avGetActiveDoc(pMxApp, pmxdoc,
pActiveView, pMap)
'
' ---Get the current font and size in use
Call GetTextFont(pmxdoc, _
fontStrg, currSize, defTFINC, defPMODE, defCOLOR)
'
' ---Get the basic graphics layer for the document
Call avSetGraphicsLayer(Null, pCurGraLyr)
'
' ---Get the ICompositeGraphicsLayer interface
Set pComGraLyr = pCurGraLyr
'
' ---Get the IGraphicsLayerScale interface
Set pGraLyrScl = pComGraLyr
'
' ---Set the reference scale for the basic graphics layer
' ---to be the same as the current map scale
pGraLyrScl.ReferenceScale = pMap.MapScale
'
' ---Define the sample text string
aString = "Sample Text String"
'
' ---Create a graphic text element using the current font
size
Call isSIZFNT(aString, currSize, currSize, 0#,
txtLen, txtHT, _
pGraphic)
'
' ---Get IDisplayTransformation
Set pDT =
pActiveView.ScreenDisplay.DisplayTransformation
'
' ---Now get the map extent of the currently visible area
Set newRect = pDT.VisibleBounds
'
' ---Get the center of the display
ccx = (newRect.XMin + newRect.XMax) / 2#
ccy = (newRect.YMin + newRect.YMax) / 2#
'
' ---Center the text about the center of the display
Set pt = New Point
pt.X = ccx - (txtLen / 2#)
pt.Y = ccy - (txtHT / 2#)
'
' ---Relocate the text to the center of the display
Call avGraphicSetShape(pGraphic, pt)
'
' ---Redraw the graphic reflecting the new position
Call avGraphicInvalidate(pGraphic)
'
' ---Display information describing the sample text
aMsg = "Text Font = " + fontStrg
aMsg = aMsg + Chr(13) + "Text Size (points) =
" + CStr(currSize)
If (defTFINC = 1) Then
aMsg = aMsg + Chr(13) +
"Italic Text = False"
Else
aMsg = aMsg + Chr(13) +
"Italic Text = True"
End If
If (defPMODE = 1) Then
aMsg = aMsg + Chr(13) + "Bold
Text = False"
Else
aMsg = aMsg + Chr(13) + "Bold
Text = True"
End If
Call avMsgBoxInfo(aMsg, "Show Sample
Text")
'
' ---Get rid of the sample text
Call avRemoveGraphic(pGraphic)
'
' ---Make sure the display is current
pActiveView.Refresh
'
End Sub
Option Explicit
'
1
2
3
4
5
6 7
'
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * *
'
*
*
' * Name: isSIZFNT
File
Name: isSIZFNT.bas *
'
*
*
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * *
'
*
*
' * PURPOSE: CREATE A GRAPHIC TEXT ELEMENT USING
THE CURRENT FONT *
'
* SIZE AND
USER SPECIFIED TEXT
STRING
*
'
*
*
' * GIVEN: aString = text
string to be sized
*
'
*
SizeH = text height (in
points)
*
'
*
SizeW = text width (in
points)
*
'
*
txtANG = text angle (in
degrees)
*
'
*
*
' * RETURN: txtLEN = length of
text
string
*
'
*
txtHT = height of text
string
*
'
* pGraphic =
element representing the text string
*
'
*
*
' * NOTE: In order for this
subroutine to function properly the *
'
* reference
scale for the basic graphics layers should *
'
* be equal to
the current map
scale
*
'
*
*
' * Dim aString As
String
*
' * Dim SizeH, SizeW, txtANG As
Double
*
' * Dim txtLEN, txtHT As
Double
*
' * Dim pGraphic As
IElement
*
'
*
*
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * *
'
Public Sub isSIZFNT(aString, SizeH, SizeW, TXTANG, txtLen, txtHT,
_
pGraphic As IElement)
'
Dim pMxApp As IMxApplication
Dim pmxdoc As IMxDocument
Dim pActiveView As IActiveView
Dim pMap As IMap
Dim pScreenDisplay As IScreenDisplay
Dim pDT As IDisplayTransformation
Dim pPoint As IPoint
Dim pSymbol As ISymbol
Dim pTextElement As ITextElement
Dim X1, Y1, aAngle As Double
'
' ---Get the active view
Call avGetActiveDoc(pMxApp, pmxdoc,
pActiveView, pMap)
'
' ---Get the active display
Call avGetDisplay(pActiveView, pScreenDisplay,
pDT)
'
' ---Create a point denoting the location of the text
Set pPoint = avPointMake(0#, 0#)
'
' ---Create an element using the point as its geometry
Set pGraphic = avGraphicTextMake(aString,
pPoint)
'
' ---Get the text symbol associated with the element
Set pSymbol = avGraphicTextGetSymbol(pGraphic)
'
' ---Assign the text an angle
Call avGraphicTextSetAngle(pGraphic, TXTANG)
'
' ---Assign the text a size
Call avSymbolSetSize("TEXT",
pSymbol, SizeH)
'
' ---Add the element to the current active graphics layer
Call avViewAddGraphic(pGraphic)
'
' ---Get the ITextElement interface
Set pTextElement = pGraphic
'
' ---Get the length and height of the text in distance units
Call GetTextRect(pTextElement, pScreenDisplay,
_
X1, Y1, aAngle, txtLen, txtHT)
'
End Sub
49.
How to assign a unique classification to a theme
'
Dim pMxApp As IMxApplication
Dim pmxdoc As IMxDocument
Dim pActiveView As IActiveView
Dim pMap As IMap
Dim theTheme As Variant
Dim theLegend As IFeatureRenderer
Dim symbList As New Collection
Dim nSymb As Long, iSymb As Long
Dim pSymbol As ISymbol
'
' ---Get the active view
Call avGetActiveDoc(pMxApp, pmxdoc,
pActiveView, pMap)
'
' ---Define the name of the polygon theme to be processed
theTheme = "L_0pg"
'
' ---Apply a unique classification to the CNT field, every
' ---polygon having a unique value of CNT will appear in a
' ---different color
Call avUnique(pmxDoc, theTheme,
"CNT", False)
'
' ---Get the legend associated with the theme
Call avGetLegend(pmxDoc, theTheme, theLegend)
'
' ---Get the symbols associated with the legend
Call avLegendGetSymbols(theLegend, symbList)
'
' ---Determine the number of symbols in the legend
nSymb = symbList.Count
'
' ---Set the color for the first and last symbols to be
' ---blue and all others to be green
For iSymb = 1 To nSymb
Set pSymbol =
symbList.Item(iSymb)
If ((iSymb = 1) Or (iSymb =
nSymb)) Then
Call avSymbolSetColor("FILL",
pSymbol, "BLUE")
Else
Call avSymbolSetColor("FILL",
pSymbol, "GREEN")
End If
Next
50.
How to process labels and symbols in a classification
'
Dim pMxApp As IMxApplication
Dim pmxdoc As IMxDocument
Dim pActiveView As IActiveView
Dim pMap As IMap
Dim theTheme As Variant
Dim theLegend As IFeatureRenderer
Dim classList As New Collection
Dim symbList As New Collection
Dim nSymb As Long, iSymb As Long
Dim pLegendClass As ILegendClass
Dim aLabel As String
Dim pSymbol As ISymbol
Dim newLabel As String
'
' ---Get the active view
Call avGetActiveDoc(pMxApp, pmxdoc,
pActiveView, pMap)
'
' ---Define the name of the POLYLINE theme to be processed
theTheme = "Alignments-Lines"
'
' ---Get the legend associated with the theme
Call avGetLegend(pmxdoc, theTheme, theLegend)
'
' ---Get a list of the classifications associated with the
theme
Call avGetClassifications(theLegend,
classList)
'
' ---Get the symbols associated with the legend
Call avLegendGetSymbols(theLegend, symbList)
'
' ---Determine the number of symbols in the legend
nSymb = symbList.count
'
' ---Cycle thru the classifications, the list of
classifications
' ---and symbols will be identicial in size
For iSymb = 1 To nSymb
'
' ---Get the ILegendClass interface
for the classification
Set pLegendClass =
classList.Item(iSymb)
'
' ---Get the label associated with
the classification
aLabel = pLegendClass.LABEL
'
' ---Get the symbol associated with
the classification
Set pSymbol =
symbList.Item(iSymb)
'
' ---Set the color for the first and
last classifications
' ---to be blue and all others to be
green
If ((iSymb = 1) Or (iSymb =
nSymb)) Then
Call avSymbolSetColor("PEN",
pSymbol, "BLUE")
Else
Call avSymbolSetColor("PEN",
pSymbol, "GREEN")
End If
'
' ---Define the new name of the
classification
newLabel = "Class_"
+ CStr(iSymb)
'
' ---Assign the new name to the
classification
pLegendClass.LABEL = newLabel
Next
'
' ---Update the table of contents to reflect the change in
the
' ---name of the classification
Call avInvalidateTOC(theTheme)
51.
How to create polyline geometry from a list of coordinates
This sample assumes that two lists (collections) exist with one
of the lists (xCor) containing x coordinates and the other (yCor)
containing y coordinates. A single part geometry object is
to be
created from these lists.
'
Dim xCor As New Collection, yCor As New Collection
Dim shapeList As New Collection, partList As New
Collection
Dim nPts As Long, i As Long
Dim xPt As Double, yPt As Double
Dim aPnt As IPoint
Dim pl As IPolyline
'
' ---Create the coordinate lists (xCor and yCor) somehow
' .........
' .........
' .........
'
' ---Create the overall shape list
Call CreateList(shapeList)
'
' ---Create the part list
Call CreateList(partList)
'
' ---Determine the number of points in the x coordinate list
nPts = xCor.Count
'
' ---Cycle thru the points comprising the single part
For i = 1 To nPts
'
' ---Extract the x and y coordinates
of a point
xPt = xCor.Item(i)
yPt = yCor.Item(i)
'
' ---Create a point object
Set aPnt = avPointMake(xPt,
yPt)
'
' ---Add the point object to the
part list
partList.Add aPnt
Next
'
' ---Add the part to the overall shape list
shapeList.Add partList
'
' ---Create the polyline object
Set pl = avPolylineMake(shapeList)
52.
How to process polyline geometry
This sample assumes that a polyline object exists and that two
lists (xCor and yCor) are to be created with each list containing
the x and y coordinates of the points which comprise the polyline,
respectively.
'
Dim pl As IPolyline
Dim xCor As New Collection, yCor As New Collection
Dim shapeList As New Collection
Dim nParts As Long, jj As Long
Dim partList As New Collection
Dim nPoints As Long, mm As Long
Dim pPoint As IPoint
Dim xPt As Double, yPt As Double
'
' ---Create the polyline object (pl) somehow (see Sample
#41)
' .........
' .........
' .........
'
' ---Create the x and y coordinate lists
Call CreateList(xCor)
Call CreateList(yCor)
'
' ---Get a list of point objects comprising the polyline
object
Call avPlAsList(pl, shapeList)
'
' ---Determine the number of parts in the polyline object
nParts = shapeList.count
'
' ---Cycle thru the parts
For jj = 1 To nParts
'
' ---Get a part from the shape
Set partList =
shapeList.Item(jj)
'
' ---Determine the number of points
comprising the part
nPoints = partList.count
'
' ---Loop thru the points in the
part
For mm = 1 To nPoints
'
' ---Get a
point from the part
Set
pPoint = partList.Item(mm)
'
' ---Extract
the x and y coordinate of the point object
xPt =
pPoint.x
yPt =
pPoint.y
'
' ---Add the
coordinates into the respective lists
xCor.Add (x)
yCor.Add (y)
Next
Next
53.
How to process polygon geometry
This sample assumes that a polygon object exists and that two
lists (xCor and yCor) are to be created with each list containing
the x and y coordinates of the points which comprise the polygon,
respectively.
'
Dim pg As IPolygon
Dim xCor As New Collection, yCor As New Collection
Dim shapeList As New Collection
Dim nParts As Long, jj As Long
Dim partList As New Collection
Dim nPoints As Long, mm As Long
Dim pPoint As IPoint
Dim xPt As Double, yPt As Double
'
' ---Create the polygon object (pg) somehow
' .........
' .........
' .........
'
' ---Create the x and y coordinate lists
Call CreateList(xCor)
Call CreateList(yCor)
'
' ---Get a list of point objects comprising the polygon
object
Call avPlAsList(pg, shapeList)
'
' ---Determine the number of parts in the polygon object
nParts = shapeList.count
'
' ---Cycle thru the parts
For jj = 1 To nParts
'
' ---Get a part from the shape
Set partList =
shapeList.Item(jj)
'
' ---Determine the number of points
comprising the part
nPoints = partList.count
'
' ---Loop thru the points in the
part
For mm = 1 To nPoints
'
' ---Get a
point from the part
Set
pPoint = partList.Item(mm)
'
' ---Extract
the x and y coordinate of the point object
xPt =
pPoint.x
yPt =
pPoint.y
'
' ---Add the
coordinates into the respective lists
xCor.Add (x)
yCor.Add (y)
Next
Next
54.
How to create a dialog box combining data line and combo-box items
'
Dim pMxApp As IMxApplication
Dim pmxdoc As IMxDocument
Dim pActiveView As IActiveView
Dim pMap As IMap
Dim aHeading As String
Dim algNumList(6) As String
Dim optionList(2) As String
Dim choiceList(3) As String
Dim Labels As New Collection
Dim Defaults As New Collection
Dim typeList As New Collection
Dim aList As New Collection
Dim jErr As Integer
Dim ndr As Long, ndr2 As Long
Dim tsiz As Double, scuvno As Long, thePI As Long
'
' ---Get the active view
Call avGetActiveDoc(pMxApp, pmxdoc,
pActiveView, pMap)
'
' ---Define the message box title (caption)
aHeading = "Sample Dialog Box with Drop-Down
Items"
'
' ---Populate the array of available horizontal alignment
numbers
algNumList(1) = "1"
algNumList(2) = "2"
algNumList(3) = "3"
algNumList(4) = "4"
algNumList(5) = "5"
algNumList(6) = "6"
'
' ---Populate the array containing the yes/no options
optionList(1) = "y"
optionList(2) = "n"
'
' ---Populate the array of available table types
choiceList(1) = "Horizontal Table"
choiceList(2) = "Vertical Table"
choiceList(3) = "No Table"
'
' ---Build the list of labels
Labels.Add ("Horizontal Alignment ID
Number:")
Labels.Add ("Number of Digits Right of Decimal
Point:")
Labels.Add ("Number of Digits Right of Decimal
Point - Seconds:")
Labels.Add ("Text Size (points):")
Labels.Add ("Starting Curve Number:")
Labels.Add ("PI to be processed (0=process all
PIs):")
Labels.Add ("Annotate all Alignment PIs (Y=yes,
N=no):")
Labels.Add ("Type of Table:")
'
' ---Build the list of default values, when a ComboBox item
is
' ---being processed an array containing the desired
drop-down
' ---options is passed as the default
Defaults.Add (algNumList)
Defaults.Add ("2")
Defaults.Add ("0")
Defaults.Add ("10")
Defaults.Add ("1")
Defaults.Add ("0")
Defaults.Add (optionList)
Defaults.Add (choiceList)
'
' ---Define the type of data line items
(1-TextBox,2-ComboBox)
typeList.Add (2)
typeList.Add (1)
typeList.Add (1)
typeList.Add (1)
typeList.Add (1)
typeList.Add (1)
typeList.Add (2)
typeList.Add (2)
'
' ---Loop until all entries are valid or user aborts the
command
Do While (True)
'
' ---Prompt the user for the parameters
Call VDBbuild("Enter
Curve Table Parameters:", _
aHeading, Labels, Defaults, typeList, aList)
'
' ---Check if the command is to be aborted
If (aList.count <= 0) Then
Exit Sub
End If
'
' ---Make sure the display is current
Call avGetDisplayFlush
'
' ---Set flag denoting no error detected
jErr = 0
'
' ---Perform a validity check on the
numeric data line items
'
' ---Determine the number of digits to the
right of the decimal
If (IsNumeric(aList.Item(2))) Then
If
(CLng(aList.Item(2)) > 0) Then
ndr = CLng(aList.Item(2))
Else
jErr = 1
Call avMsgBoxWarning("Digits value must be greater than
zero.", _
aHeading)
End If
Else
jErr = 1
Call avMsgBoxWarning("Invalid
Digits value.", aHeading)
End If
'
' ---Determine the number of digits to the
right of the decimal
If (IsNumeric(aList.Item(3))) Then
If
(CLng(aList.Item(3)) >= 0) Then
NDR2 = CLng(aList.Item(3))
Else
jErr = 1
Call avMsgBoxWarning("Digits value can not be less than
zero.", _
aHeading)
End If
Else
jErr = 1
Call avMsgBoxWarning("Invalid
Digits value.", aHeading)
End If
'
' ---Get the text size
If (IsNumeric(aList.Item(4))) Then
If
(CDbl(aList.Item(4)) > 0) Then
TSIZ = CDbl(aList.Item(4))
Else
jErr = 1
Call avMsgBoxWarning("Text Size must be greater than zero.", _
aHeading)
End If
Else
jErr = 1
Call avMsgBoxWarning("Invalid
Text Size value.", aHeading)
End If
'
' ---Get the starting curve number
If (IsNumeric(aList.Item(5))) Then
If
(CLng(aList.Item(5)) > 0) Then
SCUVNO = CLng(aList.Item(5))
Else
jErr = 1
Call avMsgBoxWarning("Curve Number must be greater than
zero.", _
aHeading)
End If
Else
jErr = 1
Call avMsgBoxWarning("Invalid
Starting Curve Number.", aHeading)
End If
'
' ---Determine the PI to be processed
If (IsNumeric(aList.Item(6))) Then
If
(CLng(aList.Item(6)) >= 0) Then
thePI = CLng(aList.Item(6))
Else
jErr = 1
Call avMsgBoxWarning("PI value can not be less than zero.", _
aHeading)
End If
Else
jErr = 1
Call avMsgBoxWarning("Invalid
PI value.", aHeading)
End If
'
' ---Check if our work is done
If (jErr = 0) Then
Exit Do
End If
55.
How to join a table to a theme
This
sample illustrates how to join a table to a layer and
transfer
a value from the table, as a result of the join, to
to
a specific feature in the layer.
'
Dim pMxApp As IMxApplication
Dim pmxdoc As IMxDocument
Dim
pActiveView As IActiveView
Dim pMap As IMap
Dim aVTab1 As String, aField1 As String
Dim aVTab2 As String, aField2 As String
Dim iok As Integer
Dim theFTab As IFields
Dim pFCls As IFeatureClass
Dim pFLyr As IFeatureLayer
Dim pTable As iTable
Dim colL As Long, colT As Long
Dim oidList As New Collection
Dim iRec As Long
Dim pFeat As iFeature
Dim pFeatRow As iRow
Dim aVal As Variant
'
' ---Get the active view
Call avGetActiveDoc(pMxApp, pmxdoc, pActiveView,
pMap)
'
' ---Define the layer that will have a join and
the field
' ---that the join will be based upon
aVTab1 = "sewnodes"
aField1 = "NODID"
'
' ---Define the table to be joined to the layer
and the field
' ---that the join will be based upon
aVTab2 = "sewhydro"
aField2 = "NODID"
'
' ---Join the table to the layer
iok = avJoin(aVTab1, aField1, aVTab2,
aField2)
'
' ---Get the attribute table for the layer,
note that the
' ---attributes in theFTab contain only the
attributes in
' ---the layer not the layer and the table
Call avGetFTab(pmxdoc, aVTab1,
theFTab, pFCls, pFLyr)
'
' ---In order to access the fields in the table
which were
' ---joined to the layer the ITable interface
must be
' ---used, otherwise only the attributes in the
layer will
' ---be found (theFTab now contains both sets
of fields)
Set pTable = pFLyr
Set theFTab = pTable.Fields
'
' ---Define a field in the layer attribute
table after the
' ---join was applied (note that the name of the
layer must
' ---precede the name of the field)
colL =
theFTab.FindField("sewnodes.GRELVZ")
'
' ---Define the field in the table which should
now appear
' ---in the attribute table as a result of the
join
colT = theFTab.FindField("sewhydro.ELEV")
'
' ---Make the theme editable
Call avSetEditable(pmxdoc, aVTab1,
True)
'
' ---Start an operation
Call avStartOperation
'
' ---Get a list of the OIDs in the layer
Call avGetFTabIDs(pmxdoc,aVTab1,
oidList)
'
' ---Define the record to be processed
iRec = oidList.Item(1)
'
' ---Get the feature in the layer to be
modified
Set pFeat = pFCls.GetFeature(iRec)
'
' ---Get the IRow for the feature (record)
since it contains the
' ---results of the join
Set pFeatRow = pTable.GetRow(iRec)
'
' ---Get the value from the table that has been
joined to the layer
aVal = pFeatRow.Value(colT)
'
' ---Transfer the table value to the feature
(note that the pFeat
' ---object, not the pFeatRow object, is used)
pFeat.Value(colL) = aVal
'
' ---Store the feature so as to write the data
to disk
pFeat.Store
'
' ---Stop the operation
Call avStopOperation("Modify
Feature")
'
' ---Remove the join from the layer
iok = avUnJoinAll(aVTab1)
56.
How to link a table to a theme
This
sample illustrates how to link a table to a layer.
'
Dim pMxApp As IMxApplication
Dim pmxdoc As IMxDocument
Dim pActiveView As IActiveView
Dim pMap As IMap
Dim aVTab1 As String, aField1 As String
Dim aVTab2 As String, aField2 As String
Dim
iok As Integer
Dim sel As ISelectionSet
Dim aQuery As String
Dim selTable As ISelectionSet
'
' ---Get the active view
Call avGetActiveDoc(pMxApp, pmxdoc,
pActiveView, pMap)
'
' ---Define the layer that will have a link
assigned to it and
' ---the field that the link will be based upon
aVTab1 = "sewnodes"
aField1 = "NODID"
'
' ---Define the table to be linked to the layer
and the field
' ---that the link will be based upon
aVTab2 = "sewhydro"
aField2 = "NODID"
'
' ---Link the table to the layer
iok = avLink(aVTab1, aField1, aVTab2,
aField2)
'
' ---Check if the link has been applied to the
layer
If (avIsLinked(aVTab1)) Then
MsgBox "Link has been applied to:
" + aVTab1
End If
'
' ---Get the current selection set for the
layer
Call avGetSelection(pmxdoc, aVTab1,
sel)
'
' ---Appy a query to the layer
aQuery = "NODID = 82309"
Call avQuery(pmxdoc, aVTab1, aQuery,
sel, "NEW")
'
' ---Get the selection set for the layer which
contains
' ---the results of the query
Call avGetSelection(pmxdoc, aVTab1,
sel)
'
' ---Update the selection set for the layer
Call avUpdateSelection(pmxdoc,
aVTab1)
'
' ---Refresh the display of the selected
features
pActiveView.PartialRefresh esriViewGeoSelection,
Nothing, Nothing
'
' ---In order to have the linked table reflect
the selection
' ---in the layer we must update the link, if
this is not
' ---done the table selection will not reflect
the link. Since
' ---the layer has only one link assigned to it
the link
' ---number is one (1)
Call avUpdateLink(aVTab1, aVTab2, 1)
'
' ---Get the selection set for the table
Call avGetSelection(pmxdoc, aVTab2,
selTable)
'
' ---Display the number of selected features in
the layer
' ---and the table
MsgBox "Selected features = " +
CStr(sel.Count) + Chr(13) + _
"Selected records = " + CStr(selTable.Count)
'
' ---Remove the link from the layer
iok = avUnLinkAll(aVTab1)
57.
How to link two themes and zoom to the Selected Features
This
sample illustrates how to link two layers, apply a query to the
first
layer, and zoom to the extent of the selected features in the
secondary
layer, which is linked to the first layer.
'
Dim pMxApp As
IMxApplication
Dim pmxdoc As IMxDocument
Dim pActiveView As
IActiveView
Dim pMap As IMap
Dim aHeading As String
Dim aVTab1 As String,
aField1 As String
Dim aVTab2 As String,
aField2 As String
Dim iok As Integer
Dim sel As ISelectionSet
Dim aQuery As String
Dim selTable As
ISelectionSet
Dim pApp As IApplication
Dim pUID As New UID
Dim pCmdItem As
ICommandItem
Dim newRect As IEnvelope
'
' ---Handle any errors that
may occur
On Error GoTo
Errorhandler
'
' ---Get the active view
Call avGetActiveDoc(pMxApp, pmxdoc, pActiveView, pMap)
'
' ---Define the name of the
command
aHeading = "Sample
Query Code"
'
' ---Define the first layer
that will have a link assigned to it
' ---and the field that the
link will be based upon
aVTab1 =
"MainLayer"
aField1 =
"LOCATION"
'
' ---Define the second
layer to be linked to the first layer and
' ---the field that the
link will be based upon
aVTab2 =
"SecondaryLayer"
aField2 =
"TITLE"
'
' ---Link the second layer
to the first layer
iok = avLink(aVTab1, aField1, aVTab2,
aField2)
'
' ---Make sure the link has
been applied to the layer
If (avIsLinked(aVTab1)) Then
'
' ---Get the current
selection set for the layer
Call avGetSelection(pmxdoc, aVTab1, sel)
'
' ---Apply a query to
the first layer and build a new selection set
aQuery =
"LOCATION = '65 WEST BROAD ST'"
Call avQuery(pmxdoc, aVTab1, aQuery, sel,
"NEW")
'
' ---Get the selection
set for the first layer which contains
' ---the results of the
query
Call avGetSelection(pmxdoc, aVTab1, sel)
'
' ---Update the
selection set for the first layer
Call avUpdateSelection(pmxdoc, aVTab1)
'
' ---Refresh the display
of the selected features
pActiveView.PartialRefresh
esriViewGeoSelection, Nothing, Nothing
'
' ---In order to have
the second layer reflect the selection
' ---in the first layer
we must update the link, if this is not
' ---done the table
selection will not reflect the link. Since
' ---the layer has only
one link assigned to it the link
' ---number is one (1)
Call avUpdateLink(aVTab1, aVTab2, 1)
'
' ---Get the selection
set for the second layer
Call avGetSelection(pmxdoc, aVTab2,
selTable)
'
' ---Display the number
of selected features in the layers
MsgBox CStr(aVTab1) +
" selected features = " + CStr(sel.Count) + Chr(13) + _
CStr(aVTab2) +
" selected features = " +
CStr(selTable.Count)
'
' ---Get the
IApplication interface
Set pApp = pMxApp
'
' ---Define the ProgID
of the [Zoom to Selected] command
pUID.Value =
"{AB073B49-DE5E-11D1-AA80-00C04FA37860}"
'
' ---Find the command
Set pCmdItem =
pApp.Document.CommandBars.Find(pUID)
'
' ---Execute the command,
provided it was found
If (Not pCmdItem Is
Nothing) Then
pCmdItem.Execute
'
' ---Zoom out (back)
a little bit (20%) to show more of the map
Call ChangeView(pmxdoc, 1, 0.8, 0#, 0#,
Nothing, _
iok,
newRect)
End If
'
' ---Inform user first link
has no link applied to it
Else
Call avMsgBoxWarning(CStr(aVTab1) + "
has no link applied to it.", _
aHeading)
End If
'
' ---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)
& aHeading)
58.
How to find graphic elements in an Annotation Group layer
'
' ---This example demonstrates how to cycle
thru the various
' ---Annotation Groups in the current data
frame finding the graphic
' ---elements which fall within the current
view extent. This sample
' ---assumes that the map is currently in a
Data View and not the
' ---Layout View
'
Dim pMxApp As IMxApplication
Dim pmxdoc As IMxDocument
Dim pActiveView As IActiveView
Dim pMap As IMap
Dim pScreenDisplay As IScreenDisplay
Dim pDT As IDisplayTransformation
Dim theRect As IEnvelope
Dim pCurGraLyr As IGraphicsLayer
Dim pCompGraLyr As ICompositeGraphicsLayer
Dim pCompLyr As ICompositeLayer
Dim nCompLyr As Long
Dim xyzRec As Long, totalRecs As Long
Dim aMessage As Variant
Dim i As Long
Dim tmpLayer As ILayer
Dim aName As Variant
Dim nGE As Long
Dim pGraContainer As IGraphicsContainer
Dim pEnumElement As IEnumElement
Dim pGraElement As IElement
'
' ---Get the active view <<<------
Call avGetActiveDoc(pMxApp,
pmxdoc, pActiveView, pMap)
'
' ---Get IDisplayTransformation for the current
view
Call avGetDisplay(pActiveView,
pScreenDisplay, pDT)
'
' ---Get the visible extent of the current view
Set theRect = pDT.VisibleBounds
'
' ---Get the basic graphics layer
Set pCurGraLyr = pMap.BasicGraphicsLayer
'
' ---Get the ICompositeGraphicsLayer interface
for the basic
' ---graphics layer
Set pCompGraLyr = pCurGraLyr
'
' ---Determine the number of Annotation Groups
in the map, note
' ---that the basic graphics layer,
<Default>, is not included
' ---in this value
Set pCompLyr = pCompGraLyr
nCompLyr = pCompLyr.Count
'
' ---Initialize the progress bar
xyzRec = 0
totalRecs = nCompLyr
aMessage = "Checking for graphic
elements in Annotation Groups..."
Call RunProgress(xyzRec,
totalRecs, aMessage)
'
' ---Cycle thru the list of Annotation Groups
For i = 1 To nCompLyr
'
' ---Extract the Annotation Group and its
name
Set tmpLayer = pCompLyr.Layer(i - 1)
aName = tmpLayer.Name
'
' ---Initialize the number of graphic
elements which fall
' ---within the current view extent for the
Annotation Group
nGE = 0
'
' ---Increment the progress bar
xyzRec = xyzRec + 1
Call RunProgress(xyzRec, totalRecs, aMessage)
'
' ---Make sure the Annotation Group layer
is visible
If (tmpLayer.Visible) Then
'
' ---Get the graphic elements associated
with the Annotation Group
Set pGraContainer = tmpLayer
'
' ---Find the graphic elements within
the current view extent
Set pEnumElement =
pGraContainer.LocateElementsByEnvelope(theRect)
'
' ---Make sure some graphic elements
were found
If (Not pEnumElement Is Nothing) Then
'
' ---Reset the enumeration
pEnumElement.Reset
'
' ---Get the first graphic element in
the enumeration
Set pGraElement =
pEnumElement.Next
'
' ---Loop until there are no more
graphic elements
Do While Not pGraElement Is
Nothing
'
' ---Add in only certain types of
graphic elements, that
' ---is, add in graphic elements
which are Points, Lines,
' ---Polygons and Text
If ((TypeOf pGraElement Is IMarkerSymbol) Or _
(TypeOf pGraElement Is
IMarkerElement) Or _
(TypeOf pGraElement Is
ILineSymbol) Or _
(TypeOf pGraElement Is
ILineElement) Or _
(TypeOf pGraElement Is
IFillSymbol) Or _
(TypeOf pGraElement Is
IFillShapeElement) Or _
(TypeOf pGraElement Is
ITextElement)) Then
'
' ---Increment the number of
graphic elements found
nGE = nGE + 1
End If
'
' ---Get the next graphic element
Set pGraElement =
pEnumElement.Next
End If
End If
'
' ---Inform the user
MsgBox CStr(nGE) + " graphic
elements found in current view for: " + _
CStr(aName)
Next
'
' ---Clear the progress bar display
xyzRec = -1
Call RunProgress(xyzRec,
totalRecs, aMessage)
59. How to parse the graphic elements in the Layout View
This sample illustrates how to cycle thru the graphic elements in
the
Layout View, including how to deal with map frames. If the Data View
is active when this sample is executed, the code below will change the
active view to be the Layout View, so as to process the graphic
elements,
and once the command has finished, it will return to the Data
View.
'
Dim pMxApp As
IMxApplication
Dim pmxDoc As IMxDocument
Dim pActiveView As
IActiveView
Dim pMap As IMap
Dim pMaps As IMaps
Dim totMaps As Long
Dim aNameMF As String
Dim AMindex As Long
Dim kMap As Long
Dim iView As Integer
Dim pPageLayout As
IPageLayout
Dim pScreenDisplay As
IScreenDisplay
Dim pDT As
IDisplayTransformation
Dim lvUnits As esriUnits
Dim pPage As IPage
Dim layoutW As Double,
layoutH As Double
Dim pContainer As
IGraphicsContainer
Dim pElement As IElement
Dim pMapFrame As
IMapFrame
Dim aScaleMF As Double
Dim pPoly As IPolygon
Dim iIn As Integer
Dim mfXMin As Double,
mfYMin As Double
Dim mfXMax As Double,
mfYMax As Double
Dim mapIndex As Long
Dim worldXmin As Double,
worldYmin As Double
Dim worldXmax As Double,
worldYmax As Double
Dim pScreenDisplayDV As
IScreenDisplay
Dim pDTDV As IDisplayTransformation
Dim dvUnits As esriUnits
Dim thmList As New
Collection
Dim nThemes As Long
Dim pApp As IApplication
Dim pUID As New UID
Dim pCmdItem As
ICommandItem
'
' ---Get the active view
Call avGetActiveDoc(pMxApp, pmxDoc, pActiveView, pMap)
'
' ---Get a collection of
all of the maps in the document
Set pMaps = pmxDoc.Maps
'
' ---Determine the total
number of maps in the document
totMaps = pMaps.Count
'
' ---Get the name of the
current active map
aNameMF = pMap.Name
'
' ---Initialize the active
map index value
AMindex = -1
'
' ---Cycle thru the
collection of maps for this map
For kMap = 1 To totMaps
Set pMap =
pMaps.Item(kMap - 1)
' ---Check if we have
found the active map
If (aNameMF =
pMap.Name) Then
' ---Preserve the
current active map index
AMindex = kMap - 1
Exit For
End If
Next
'
' ---Set flag denoting the
command was selected in Layout View
iView = 2
'
' ---Check if the Data View
is active
If TypeOf pActiveView Is
IMap Then
'
' ---Set flag denoting
the command was selected in Data View
iView = 1
'
' ---Change the display
to be in Layout view
Set pmxDoc.ActiveView
= pmxDoc.PageLayout
Set
pmxDoc.ActiveView.FocusMap = pMap
End If
'
' ---At this point we are
now in Layout View and can begin to
' ---process the elements
in Layout View
'
' ---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
Set pScreenDisplay =
pActiveView.ScreenDisplay
Set pDT =
pActiveView.ScreenDisplay.DisplayTransformation
'
' ---Get the units of
measure for the Layout View, this will be
' ---inches, millimeters,
etc.
lvUnits = pDT.Units
'
' ---Get the IPage
interface
Set pPage =
pPageLayout.Page
'
' ---Get the size of the
layout (11"x17", 24"x36", etc.)
pPage.QuerySize layoutW,
layoutH
'
' ---Get a list of the
graphic elements in the Layout View
Set pContainer = pPageLayout
'
' ---Reset the current
position in the list to the beginning
pContainer.Reset
'
' ---Cycle thru the graphic
elements in the page layout determining
' ---the type of element we
are dealing with
Set pElement =
pContainer.Next
While Not pElement Is
Nothing
'
' ---Check if we have a
GRAPHIC ELEMENT that we can process
If ((TypeOf pElement
Is ITextElement) Or _
(TypeOf pElement
Is ILineElement) Or _
(TypeOf pElement
Is IRectangleElement) Or _
(TypeOf pElement Is IPolygonElement) Or _
(TypeOf pElement
Is ICircleElement) Or _
(TypeOf pElement
Is IMarkerElement)) Then
'
' ---Do something
with the element
End If
'
' ---Check if we have a
MAP FRAME that we can process
If TypeOf pElement Is
IMapFrame Then
'
' ---Get the
IMapFrame object
Set pMapFrame =
pElement
'
' ---Get the name of
the map associated with the map frame
aNameMF =
pMapFrame.Map.Name
'
' ---Get the scale of
the map associated with the map frame
aScaleMF =
pMapFrame.Map.MapScale
'
' ---Get the geometry
of the map frame, this will be the rectangle
' ---in the Layout
View where the map frame resides
Set pPoly =
pElement.Geometry
'
' ---Set flag
denoting that the map frame falls outside the page
' ---layout boundary
(as such it will not appear when the layout
' ---is sent to the
printer)
iIn = 0
'
' ---Get the
coordinates of the low left and upper right corners
' ---of the map frame
in Layout View units (inches, millimeters, etc.)
mfXMin =
pPoly.Envelope.xMin
mfYMin =
pPoly.Envelope.yMin
mfXMax =
pPoly.Envelope.xMax
mfYMax = pPoly.Envelope.yMax
'
' ---Check if the map
frame is completely within the page layout
' ---boundary
If ((mfXMin >=
0#) And (mfYMin >= 0#) And _
(mfXMax <=
layoutW) And (mfYMax <= layoutH)) Then
'
' ---Set flag the
map frame is completely within the boundary
iIn = 1
End If
'
' ---Check if the map
frame is within the page layout boundary
If (iIn = 1) Then
'
' ---Initialize
the map index value (map not found)
mapIndex = -1
'
' ---Cycle thru
the collection of maps for this document
For kMap = 1 To
totMaps
Set pMap =
pMaps.Item(kMap - 1)
' ---Check if
we have found the map
If (aNameMF
= pMap.Name) Then
'
---Preserve the map index
mapIndex
= kMap - 1
Exit For
End If
Next
'
' ---Get the
minimum X and Y world map coordinates (Data View)
worldXmin =
pMapFrame.MapBounds.xMin
worldYmin =
pMapFrame.MapBounds.yMin
' ---Get the
maximum X and Y world map coordinates (Data View)
worldXmax =
pMapFrame.MapBounds.xMax
worldYmax =
pMapFrame.MapBounds.yMax
'
' ---Change the display to be in Data view
If
(pmxDoc.FocusMap.Name <> pMap.Name) Then
Set
pmxDoc.ActiveView.FocusMap = pMap
End If
Set pActiveView
= pmxDoc.FocusMap
'
' ---Get the display
and transformation for the map in Data View
Set
pScreenDisplayDV = pActiveView.ScreenDisplay
Set pDTDV =
pActiveView.ScreenDisplay.DisplayTransformation
'
' ---Get the Data
View units (feet, meters, etc.)
dvUnits = pDTDV.Units
'
' ---Get a list of
the themes in the map expanding group layers
Call avGetThemes(pmxDoc, 5, thmList)
'
' ---Determine the
number of themes in the list
nThemes =
thmList.Count
'
' ---Inform the user as to the properties of
the map frame
' ---that was just
processed
MsgBox
"Layout Width, Height: " + _
CStr(layoutW) + " x " + CStr(layoutH) + Chr(13) + _
"Map
Name: " + CStr(aNameMF) + Chr(13) + _
"Map
XMin, YMin: " + Dformat(worldXmin, 1, 3) + " " + _
Dformat(worldYmin, 1, 3) + Chr(13) + _
"Map
XMax, YMax: " + Dformat(worldXmax, 1, 3) + " " + _
Dformat(worldYmax, 1, 3) + Chr(13) + _
"Map
Frame XMin, YMin: " + Dformat(mfXMin, 1, 3) + " " + _
Dformat(mfYMin, 1, 3) + Chr(13) + _
"Map Frame XMax, YMax: " +
Dformat(mfXMax, 1, 3) + " " +
_
Dformat(mfYMax, 1, 3) + Chr(13) + _
"Map
Units: " + CStr(dvUnits) + Chr(13) + _
"Layout Units: " + CStr(lvUnits) + Chr(13) + _
"Number of themes in " + CStr(aNameMF) + ": " +
CStr(nThemes)
'
' ---Handle case when
the map frame is not completely in
' ---the page layout
boundary
Else
MsgBox "The
Map " + CStr(aNameMF) + _
" is
not completely within the Page Layout boundary."
End If
End If
'
' ---Get the next
element in the layout container
Set pElement =
pContainer.Next
Wend
'
' ---Reset the active map
to be the one when the command was
' ---initially activated
Set pMap =
pMaps.Item(AMindex)
'
' ---Check if we originally
started out in Data View
If (iView = 1) Then
'
' ---Change the map
focus to be the initial active map
If
(pmxDoc.FocusMap.Name <> pMap.Name) Then
Set
pmxDoc.ActiveView.FocusMap = pMap
End If
Set pActiveView =
pmxDoc.FocusMap
'
' ---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
'
' ---Handle case when we
started out in Layout View
Else
'
' ---Change the 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
End If
60.
How to find all of the graphic text elements in a Data View
'
' ---This example demonstrates how to build a
list of all of the
'
---graphic text elements in a Data
View. This sample assumes
' ---that the map is currently in a Data View
and not the Layout
' ---View.
'
Dim pMxApp As IMxApplication
Dim pmxdoc As IMxDocument
Dim pActiveView As IActiveView
Dim pMap As IMap
Dim graphList As New Collection
Dim pGLayer As IGraphicsLayer
Dim pContainer As IGraphicsContainer
Dim pElement As IElement
Dim pCurGraLyr As IGraphicsLayer
Dim pCompGraLyr As ICompositeGraphicsLayer
Dim pCompLyr As ICompositeLayer
Dim
nCompLyr As Long
Dim i As Long
Dim tmpLayer As iLayer
Dim aName As Variant
'
' ---Get the active view
<<<------
Call avGetActiveDoc(pMxApp,
pmxdoc, pActiveView, pMap)
'
' ---Initialize the list of
the graphic text elements
Call CreateList(graphList)
'
' ---Get all of the graphic
elements in the Data View
' ---for the basic graphics
layer, <Default>, only. Note that
' ---this does not contain
any graphics which are in the ‘Group’
' ---or ‘Annotation Taget’
Layers
Set pGLayer =
pActiveView.FocusMap.BasicGraphicsLayer
Set pContainer = pGLayer
'
' ---Reset the current
position in the list to the beginning
pContainer.Reset
'
' ---Get the first graphic
element in the list
Set pElement =
pContainer.Next
'
' ---Cycle thru the list
until we run out of graphic elements
While Not pElement Is
Nothing
'
' ---Check if this
graphic element is a graphic text element
If TypeOf pElement Is
ITextElement Then
'
' ---Add the graphic
element to the list
graphList.Add
pElement
End If
'
' ---Get the next
graphic element in the list
Set pElement =
pContainer.Next
Wend
'
' ---Now, we will process
the ‘Group’ or ‘Annotation Target’ Layers
' ---which may exist in the
Data View
'
' ---Get the basic graphics
layer
Set pCurGraLyr =
pMap.BasicGraphicsLayer
'
' ---Get the
ICompositeGraphicsLayer interface for the basic
' ---graphics layer
Set pCompGraLyr =
pCurGraLyr
'
' ---Determine the number
of Annotation Groups in the map, note
' ---that the basic
graphics layer, <Default>, is not included
' ---in this value
Set pCompLyr =
pCompGraLyr
nCompLyr = pCompLyr.Count
'
' ---Make sure there are
some layers to process
If (nCompLyr > 0) Then
'
' ---Cycle thru the list
of Annotation Groups
For i = 1 To nCompLyr
'
' ---Extract the
Annotation Group and its name
Set tmpLayer =
pCompLyr.Layer(i - 1)
aName =
tmpLayer.name
'
' ---Make sure the
Annotation Group layer is visible
If
(tmpLayer.Visible) Then
'
' ---Get the
Annotation Group’s graphic elements
Set pContainer
= tmpLayer
'
' ---Reset the
current position in the list to the beginning
pContainer.Reset
'
' ---Get the
first graphic element in the list
Set pElement =
pContainer.Next
'
' ---Cycle thru
the list until we run out of graphic elements
While Not
pElement Is Nothing
'
' ---Check if this graphic element is a graphic
text element
If (TypeOf
pElement Is ITextElement) Then
'
' ---Add
the graphic element to the list
graphList.Add pElement
End If
'
' ---Get the next element in the layout
container
Set pElement
= pContainer.Next
Wend
End If
Next
End If
61.
How to find all of the graphic text elements in the Layout View
'
' ---This example demonstrates how to build a
list of all of the
' ---graphic text elements in the Layout
View. This sample will
' ---change the map display to be in Layout
View, if it is not already
' ---in Layout View.
'
Dim pMxApp As IMxApplication
Dim pmxdoc As IMxDocument
Dim pActiveView As IActiveView
Dim pMap As IMap
Dim graphList As New Collection
Dim pPageLayout As
IPageLayout
Dim pContainer As
IGraphicsContainer
Dim pElement As IElement
'
' ---Get the active view <<<------
Call avGetActiveDoc(pMxApp,
pmxdoc, pActiveView, pMap)
'
' ---Initialize the list of
the graphic text elements
Call CreateList(graphList)
'
' ---Define the IPageLayout
object
Set pPageLayout =
pmxDoc.PageLayout
'
' ---Redefine the
IActiveView object using the IPageLayout object
Set pActiveView =
pPageLayout
'
' ---Get a list of the
graphic elements in the Layout View
Set pContainer =
pPageLayout
'
' ---Reset the current
position in the list to the beginning
pContainer.Reset
'
' ---Get the first graphic
element in the list
Set pElement =
pContainer.Next
'
' ---Cycle thru the list
until we run out of graphic elements
While Not pElement Is
Nothing
'
' ---Check if this graphic
element is a graphic text element
If (TypeOf pElement Is
ITextElement) Then
'
' ---Add the graphic
element to the list
graphList.Add
pElement
End If
'
' ---Get the next
element in the layout container
Set pElement =
pContainer.Next
Wend
62. How to convert selected graphic text elements into Callouts
'
' ---This sample
illustrates how to convert selected graphic text
' ---elements into a
Callout. Either Balloon or Line callouts
can
' ---be created with the Balloon callout being
of rectangle or
' ---rounded rectangle type. The code also provides the ability
' ---to remove the Callout from the selected
graphic text element
' ---thereby converting the Callout back to a
graphic text element.
'
Dim pMxApp As
IMxApplication
Dim pMxDoc As IMxDocument
Dim pActiveView As
IActiveView
Dim pMap As IMap
Dim pScreenDisplay As
IScreenDisplay
Dim pDT As
IDisplayTransformation
Dim Heading As String
Dim selgraphlist As New
Collection
Dim pMapGraphicsSelect As
IGraphicsContainerSelect
Dim i As Long
Dim pElement As IElement
Dim nGTE As Long
Dim choiceList(4) As
String
Dim colorList(13) As
String
Dim optionList(2) As
String
Dim aMsg As String
Dim labList As New Collection,
defList As New Collection
Dim typeList As New
Collection, aList As New Collection
Dim aStyle As Variant,
LCGapv As Variant
Dim FilClr As Variant,
FilWid As Variant, addAnc As Variant
Dim iGTE As Long
Dim pTextElement As
ITextElement
Dim X1 As Double, Y1 As
Double
Dim aAngle As Double,
aWidth As Double, aHeight As Double
Dim pAnchor As IPoint
Dim pTextBack As
ITextBackground
Dim pCallout As ICallout
Dim pBC As
IBalloonCallout
Dim pLC As ILineCallout
Dim pFormTextSymbol As
IFormattedTextSymbol
Dim aDefClr As iColor
Dim pFS As IFillSymbol
Dim pPoint As IPoint
Dim pSym As ISymbol
'
' ---Handle any errors that
may occur
On Error GoTo
Errorhandler
'
' ---Get the active view
Call avGetActiveDoc(pMxApp,
pmxdoc, pActiveView, pMap)
'
' ---Get the display
associated with the active view
' ---checking to see if a
data view is actve, if not then a
' ---layout view is active
If TypeOf pActiveView Is
IMap Then
Set pScreenDisplay = pActiveView.ScreenDisplay
Set pDT =
pActiveView.ScreenDisplay.DisplayTransformation
' ---Layout view is active
Else
Set pScreenDisplay =
pActiveView.ScreenDisplay
Set pDT =
pActiveView.ScreenDisplay.DisplayTransformation
End If
'
' ---Define the message box
title
Heading = "Callout
from Selected Text"
'
' ---Initialize the list
containing the selected graphics
Call CreateList(selgraphlist)
'
' ---Check for selected
graphic text elements by cycling thru the
' ---selected graphics in
the map
Set pMapGraphicsSelect =
pMap
' ---Make sure the map has
some selected graphics
If
(pMapGraphicsSelect.ElementSelectionCount > 0) Then
For i = 1 To
pMapGraphicsSelect.ElementSelectionCount
Set pElement =
pMapGraphicsSelect.SelectedElement(i - 1)
' ---Preserve only
the graphic text elements ignoring
' ---any other types
of graphics
If TypeOf pElement
Is ITextElement Then
selgraphlist.Add pElement
End If
Next
End If
'
' ---Determine the number
of selected graphic text elements
nGTE = selgraphlist.Count
'
' ---Check if there are no
selected graphic text elements
If (nGTE <= 0) Then
Call avMsgBoxWarning("No graphic text
element selected.", _
Heading)
Exit Sub
End If
'
' ---Build a list of the
available callout styles, the None option
' ---will remove the
Callout from the graphic text element thereby
' ---leaving the graphic as
a simple graphic text element
choiceList(1) =
"Rectangle"
choiceList(2) =
"Rounded Rectangle"
choiceList(3) =
"Line"
choiceList(4) =
"None"
'
' ---Build a list of
callout fill colors
colorList(1) =
"Default"
colorList(2) =
"WHITE"
colorList(3) =
"BLACK"
colorList(4) =
"BLUE"
colorList(5) =
"GREEN"
colorList(6) =
"YELLOW"
colorList(7) =
"CYAN"
colorList(8) =
"BROWN"
colorList(9) =
"ORANGE"
colorList(10) =
"RED"
colorList(11) =
"MAGENTA"
colorList(12) =
"GRAY"
colorList(13) =
"LIGHT GRAY"
'
' ---Define the options
optionList(1) =
"Yes"
optionList(2) =
"No"
'
' ---Define the message box
parameters
aMsg = "Enter
Callout Parameters:"
Call CreateList(labList)
labList.Add ("Type
of Callout:")
labList.Add ("Line Callout
Gap value (0=no gap):")
labList.Add ("Fill
Color:")
labList.Add ("Fill
Outline Width (0=no outline):")
labList.Add ("Add
anchor if missing (Y=yes, N=no):")
Call CreateList(defList)
defList.Add (choiceList)
defList.Add
("0")
defList.Add (colorList)
defList.Add
("1")
defList.Add (optionList)
Call CreateList(typeList)
typeList.Add (2)
typeList.Add (1)
typeList.Add (2)
typeList.Add (1)
typeList.Add (2)
'
' ---Loop until all the
data is entered correctly or the user
' ---wishes to abort the
command
Do While (True)
'
' ---Prompt the user for
the text string attributes
Call VDBbuild(aMsg, Heading, labList,
defList, typeList, aList)
'
' ---Check if the user
wishes to abort the command
If (aList.Count <=
0) Then
Call avShowMsg("Select graphic text
elements for processing")
Exit Sub
End If
'
' ---Extract the data
aStyle = aList.Item(1)
LCGapv = aList.Item(2)
FilClr = aList.Item(3)
FilWid = aList.Item(4)
addAnc = aList.Item(5)
'
' ---Validity check
If (Not
IsNumeric(LCGapv)) Then
Call avMsgBoxWarning("Invalid Gap
value.", Heading)
ElseIf (CDbl(LCGapv)
< 0#) Then
Call avMsgBoxWarning("Invalid Gap value.",
Heading)
'
ElseIf (Not
IsNumeric(FilWid)) Then
Call avMsgBoxWarning("Invalid Fill
width.", Heading)
ElseIf (CDbl(FilWid)
< 0#) Then
Call avMsgBoxWarning("Invalid Fill
width.", Heading)
Else
Exit Do
End If
'
' ---Make sure the display
is current
Call avGetDisplayFlush
'
' ---Cycle thru the
selected graphic text elements
For iGTE = 1 To nGTE
'
' ---Get a graphic text
element
Set pElement =
selgraphlist.Item(iGTE)
'
' ---Get the
ITextElement interface
Set pTextElement =
pElement
'
' ---Get the size of
the text this will be used in establishing the
' ---anchor point
location, if appropriate
Call GetTextRect(pTextElement,
pScreenDisplay, _
X1, Y1, aAngle, aWidth,
aHeight)
'
' ---Initialize the
anchor point variable
Set pAnchor = Nothing
'
' ---Initialize the
background assigned to the text element
Set pTextBack =
Nothing
'
' ---Initialize the
callouts assigned to the text element
Set pCallout =
Nothing
Set pBC = Nothing
Set pLC = Nothing
'
' ---Check if the
symbol that is associated with the text element
' ---is an
IFormattedTextSymbol
If (TypeOf
pTextElement.Symbol Is IFormattedTextSymbol) Then
'
' ---Get the symbol
associated with the text element
Set
pFormTextSymbol = pTextElement.Symbol
'
' ---Get the
background associated with the text element
Set pTextBack = pFormTextSymbol.Background
'
' ---Check if there
is no background
If (pTextBack Is
Nothing) Then
'
' ---Check if the
text has a balloon callout assigned to it
ElseIf (TypeOf
pTextBack Is IBalloonCallout) Then
Set pBC = pTextBack
If
(pBC.AnchorPoint Is Nothing) Then
Else
Set pAnchor
= pBC.AnchorPoint
End If
Set pCallout =
pBC
'
' ---Check if the
text has a line callout assigned to it
ElseIf (TypeOf pTextBack Is
ILineCallout) Then
Set pLC =
pTextBack
If
(pLC.AnchorPoint Is Nothing) Then
Else
Set pAnchor
= pLC.AnchorPoint
End If
Set pCallout =
pLC
End If
End If
'
' ---Create a new text
symbol using the attributes of the
' ---selected graphic
text element
Set pFormTextSymbol =
New TextSymbol
pFormTextSymbol.Font
= pTextElement.Symbol.Font
pFormTextSymbol.Size
= pTextElement.Symbol.Size
pFormTextSymbol.HorizontalAlignment =
pTextElement.Symbol.HorizontalAlignment
pFormTextSymbol.VerticalAlignment =
pTextElement.Symbol.VerticalAlignment
'
' ---Initialize the
default color
Set aDefClr = Nothing
'
' ---Use the callout
style specified by the user, if any
If (aStyle <>
"None") Then
'
' ---Create a new
callout, if need be
If (pCallout Is
Nothing) Then
'
' ---Create a new
balloon callout
If ((aStyle =
"Rectangle") Or _
(aStyle =
"Rounded Rectangle")) Then
Set pCallout
= New BalloonCallout
Set pBC =
pCallout
Else
Set pCallout
= New LineCallout
Set pLC = pCallout
' ---Assign
the gap value to the callout
pLC.Gap =
CDbl(LCGapv)
End If
'
' ---Create a
temporary new callout and get the default
' ---color assigned
to the callout
Else
'
' ---Create a new
balloon callout
If ((aStyle =
"Rectangle") Or _
(aStyle =
"Rounded Rectangle")) Then
Set pCallout
= New BalloonCallout
Set pBC =
pCallout
Set pFS = pBC.Symbol
Set aDefClr
= pFS.Color
Else
Set pCallout
= New LineCallout
Set pLC =
pCallout
Set pFS =
pLC.Border
Set aDefClr
= pFS.Color
End If
End If
'
' ---Assign the type
of callout desired by the user
If (aStyle =
"Rectangle") Then
pBC.Style =
esriBCSRectangle
ElseIf (aStyle =
"Rounded Rectangle") Then
pBC.Style =
esriBCSRoundedRectangle
End If
'
' ---Transfer the
anchor point, if one exists
If (Not pAnchor Is
Nothing) Then
If ((aStyle =
"Rectangle") Or _
(aStyle =
"Rounded Rectangle")) Then
pBC.AnchorPoint
= pAnchor
Else
pLC.AnchorPoint = pAnchor
End If
'
' ---Handle case
when the callout does not have an anchor
' ---assigned to it
Else
'
' ---Check if the
anchor is to be added
If
((UCase(addAnc) = "Y") Or _
(UCase(addAnc) = "YES")) Then
' ---Define an
arbitrary anchor point
Set pPoint =
avPointMake((X1 - aWidth / 2#), _
(Y1 - aWidth / 2#))
If ((aStyle
= "Rectangle") Or _
(aStyle
= "Rounded Rectangle")) Then
pBC.AnchorPoint = pPoint
Else
pLC.AnchorPoint = pPoint
End If
End If
End If
'
' ---Get the
IFillSymbol for the callout
If ((aStyle =
"Rectangle") Or _
(aStyle =
"Rounded Rectangle")) Then
Set pFS =
pBC.Symbol
Else
Set pFS =
pLC.Border
End If
'
' ---Assign the
color and outline width to the symbol
Set pSym = pFS
If (FilClr
<> "Default") Then
Call avSymbolSetColor("FILL",
pSym, FilClr)
Else
If (Not aDefClr
Is Nothing) Then
If ((aStyle
= "Rectangle") Or _
(aStyle
= "Rounded Rectangle")) Then
pBC.Symbol.Color = aDefClr
Else
pLC.Border.Color = aDefClr
End If
End If
End If
If (FilWid >
0#) Then
Call avSymbolSetOLWidth("FILL",
pSym, FilWid)
Else
If (FilClr
<> "Default") Then
Call avSymbolSetOLColor("FILL", pSym,
FilClr)
Else
Call avSymbolSetOLColor("FILL",
pSym, "WHITE")
End If
End If
'
' ---Assign the
callout to the text symbol
Set
pFormTextSymbol.Background = pCallout
End If
'
' ---Assign the text symbol to the text
element
pTextElement.Symbol =
pFormTextSymbol
Next
'
' ---Flag the area of the
new element for refreshing
pMxDoc.ActiveView.PartialRefresh esriViewGraphics, Nothing, Nothing
'
' ---Prompt the user
Call avShowMsg(CStr(nGTE)
+ " graphic text elements processed, " + _
"Select graphic text elements for processing")
'
' ---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: ConvertGraphicToCallout")
63. How to print the current data frame
This sample illustrates how to print the current data frame,
regardless
if the data frame is in Layout View or Data View.
'
Dim pMxApp As
IMxApplication
Dim pmxDoc As IMxDocument
Dim pActiveView As
IActiveView
Dim pMap As IMap
Dim pApp As IApplication
Dim pPrinter As IPrinter
Dim pUID As New UID
Dim pCmdItem As
ICommandItem
'
' ---Get the active view
Call avGetActiveDoc(pMxApp, pmxDoc, pActiveView, pMap)
'
' ---Get the IApplication
object
Set pApp = pMxApp
'
' ---Get the Printer
currently assigned to the application
Set pPrinter =
pMxApp.Printer
'
' ---Check if a PDF driver
is the active printer, the Avenue Wrap
' ---avViewPrint is
designed to print to a printer, not to export
' ---a map to a PDF
file. If a PDF driver is the active
printer
' ---we will use the ArcMap
Export Map... command to create the
' ---PDF file
If ((pPrinter.DriverName
= "Acrobat PDFWriter") Or _
(pPrinter.DriverName
= "Acrobat Distiller") Or _
(pPrinter.DriverName
= "AdobePS Acrobat Distiller")) Then
'
' ---Define the GUID of
the Export Map... command
pUID.Value =
"{119591DB-0255-11D2-8D20-080009EE4E51}"
pUID.SubType = 9
'
' ---Find the command
Set pCmdItem =
Application.Document.CommandBars.Find(pUID)
'
' ---Execute the Export
Map... command programmatically
pCmdItem.Execute
'
' ---Handle the case when
we can print to a printer
Else
'
' ---Print the map from
either Data View or the Layout View
Call avViewPrint
End If
64. How to print the current data frame from the Layout View
This sample illustrates how to print the current data frame from
the
Layout View. If the Data
View is active when this sample is executed,
the code below will change the active view to be the Layout View.
Once
the command has finished, it will return to the Data View.
'
Dim pMxApp As
IMxApplication
Dim pmxDoc As IMxDocument
Dim pActiveView As
IActiveView
Dim pMap As IMap
Dim pApp As IApplication
Dim pPrinter As IPrinter
Dim pUID As New UID
Dim pCmdItem As
ICommandItem
Dim iView As Integer
'
' ---Get the active view
Call avGetActiveDoc(pMxApp, pmxDoc, pActiveView, pMap)
'
' ---Get the IApplication
object
Set pApp = pMxApp
'
' ---Get the Printer
currently assigned to the application
Set pPrinter =
pMxApp.Printer
'
' ---Check if a PDF driver
is the active printer, the Avenue Wrap
' ---avViewPrint is
designed to print to a printer, not to export
' ---a map to a PDF
file. If a PDF driver is the active
printer
' ---we will use the ArcMap
Export Map... command
If ((pPrinter.DriverName
= "Acrobat PDFWriter") Or _
(pPrinter.DriverName
= "Acrobat Distiller") Or _
(pPrinter.DriverName
= "AdobePS Acrobat Distiller")) Then
'
' ---Define the GUID of
the Export Map... command
pUID.Value =
"{119591DB-0255-11D2-8D20-080009EE4E51}"
pUID.SubType = 9
'
' ---Find the command
Set pCmdItem =
Application.Document.CommandBars.Find(pUID)
'
' ---Execute the Export
Map... command programmatically
pCmdItem.Execute
'
' ---Handle the case when
we can print to a printer
Else
'
' ---Set flag denoting
the command was selected in Layout View
iView = 2
'
' ---Check if the Data
View is active
If TypeOf pActiveView
Is IMap Then
'
' ---Set flag denoting the command was
selected in Data View
iView = 1
'
' ---Change the
display to be in Layout view
Set
pmxDoc.ActiveView = pmxDoc.PageLayout
Set
pmxDoc.ActiveView.FocusMap = pMap
End If
'
' ---Print the map from
the Layout View. This assumes that the user
' ---has properly
positioned the data frame on the layout page as
' ---desired
Call avViewPrint
'
' ---Check if we
originally started out in Data View
If (iView = 1) Then
'
' ---Change the map
focus to be the initial active map
If
(pmxDoc.FocusMap.Name <> pMap.Name) Then
Set
pmxDoc.ActiveView.FocusMap = pMap
End If
Set pActiveView =
pmxDoc.FocusMap
'
' ---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
End If
End If
65. How to display and edit the attributes of a selected feature
This sample illustrates how to display in a multi-input dialog box
the
attributes of a selected feature.
This sample assumes that there is a
feature that is selected, if not, an appropriate error message
will be
displayed. Likewise, if
more than 1 feature is selected another
appropriate error message will be displayed. If only 1 feature has been
selected, the code below will display in blocks of 10 the
attribute and
the value assigned to the attribute. The user can then enter a different
value, if desired. A BACK
button is available so that the user can
return to previous pages, if need be. The editing is placed in an
operation, so that, the user can use the {Edit} [Undo Edit
Feature]
command to remove the changes which may have been made.
'
Dim pMxApp As
IMxApplication
Dim pmxdoc As IMxDocument
Dim pActiveView As
IActiveView
Dim pMap As IMap
Dim Heading As String
Dim themeList As New
Collection
Dim selThmList As New
Collection
Dim selRecList As New
Collection
Dim theTheme As Variant
Dim theOID As Long
Dim theFTab As IFields
Dim pFeatureClass As
IFeatureClass
Dim aLayer As
IFeatureLayer
Dim pFeature As IFeature
Dim sShpName As String
Dim nAtts As Long,
itmPerGrp As Long, nGroups As Long
Dim jItem As Long, iGroup
As Long
Dim entryList As New
Collection
Dim defaultInfo As New
Collection
Dim typeList As New
Collection
Dim iItem As Long
Dim pField As iField
Dim aValue As Variant
Dim aPrmpt As String
Dim userInfo As New
Collection
Dim nItems As Long, jErr
As Long
Dim aMessage As Variant
Dim kk As Long
Dim colStrng As String
Dim theCol As Long, col
As Long, kErr As Long
'
' ---Handle any errors that
may occur
On Error GoTo
Errorhandler
'
' ---Get the active view
Call avGetActiveDoc(pMxApp, pmxdoc, pActiveView, pMap)
'
' ---Define the message box
titles
Heading = "Edit
Feature Attributes"
'
' ---Get a list of all the
feature and annotation layers
Call avGetThemes(pmxdoc, 1, themeList)
'
' ---Check if the map does
not contain any valid layers
If (themeList.Count <=
0) Then
Call avMsgBoxWarning("No Feature or
Annotation layers exist.", _
Heading)
Exit Sub
End If
'
' ---Get a list of the
selected features in the feature and
' ---annotation layers
Call avGetSelFeatures(pmxdoc, themeList, 0, _
selThmList, selRecList)
'
' ---Check if there are no
selected features
If (selThmList.Count
<= 0) Then
Call avMsgBoxWarning("No Feature has
been selected.", _
Heading)
Exit Sub
End If
'
' ---Check if more than one
selected feature was found
If ((selThmList.Count
> 2) Or (selThmList.Item(2) > 1)) Then
Call avMsgBoxWarning("More than 1
Feature has been selected.", _
Heading)
Exit Sub
End If
'
' ---Get the name of the
theme and OID for the first feature in
' ---the list
theTheme =
selThmList.Item(1)
theOID =
selRecList.Item(1)
'
' ---Get the attribute
table associated with the theme
Call avGetFTab(pmxdoc, theTheme, theFTab, pFeatureClass, aLayer)
'
' ---Get the feature using
the object id of the feature
Set pFeature =
pFeatureClass.GetFeature(theOID)
'
' ---Make sure the theme is
editable
Call avSetEditable(pmxdoc, theTheme, True)
'
' ---Set the current task
of the editor to be create a new
' ---feature (this way no
handles will appear about the selected
' ---feature)
Call avSetEditableTheme(pmxdoc, theTheme, 2)
'
' ---Get the name of the
shape field
sShpName =
pFeatureClass.ShapeFieldName
'
' ---Determine the number
of attributes
nAtts = theFTab.FieldCount
'
' ---Define the number of
items per group
itmPerGrp = 10
'
' ---Determine the number
of groups, accounting for the fact
' ---that the SHAPE field
will not be presented
nGroups = Fix(((nAtts -
1) + (itmPerGrp - 1)) / itmPerGrp)
'
' ---Initialize the
attribute index counter
jItem = -1
'
' ---Initialize the group
counter
iGroup = 0
'
' ---Loop thru the groups
Do While (iGroup <=
nGroups)
'
' ---Increment the
group counter
iGroup = iGroup + 1
'
' ---Check if we are done
If (iGroup >
nGroups) Then
Exit Do
End If
'
' ---Initialize the
input and default value lists
Call CreateList(entryList)
Call CreateList(defaultInfo)
Call CreateList(typeList)
'
' ---Build the input
and default value lists
For iItem = 1 To
itmPerGrp
jItem = jItem + 1
If (jItem <
nAtts) Then
Set pField =
theFTab.Field(jItem)
' ---Check if
the SHAPE field is not being processed
If
(UCase(sShpName) <> UCase(pField.name)) Then
entryList.Add ((pField.aliasName + " "))
aValue =
pFeature.Value(jItem)
If (Not
IsNull(aValue)) Then
defaultInfo.Add
(aValue)
typeList.Add (1)
Else
defaultInfo.Add (" ")
typeList.Add (1)
End If
' ---Handle case
when SHAPE field is found, in this
' ---case jump to the next attribute
Else
jItem =
jItem + 1
If (jItem
< nAtts) Then
Set
pField = theFTab.Field(jItem)
entryList.Add ((pField.aliasName + " "))
aValue =
pFeature.Value(jItem)
If (Not
IsNull(aValue)) Then
defaultInfo.Add (aValue)
typeList.Add (1)
Else
defaultInfo.Add (" ")
typeList.Add (1)
End If
End If
End If
End If
Next
'
' ---Define the prompt
aPrmpt = "Enter
Data (page " + CStr(iGroup) + _
" of
" + CStr(nGroups) + "):"
'
' ---Prompt the user
Call VDBbuild2(aPrmpt, Heading, entryList,
defaultInfo, typeList, _
userInfo)
'
' ---Make sure the
current display is current
Call avGetDisplayFlush
'
' ---If the user
cancelled the user input information, then abort
nItems =
userInfo.Count
If (nItems <= 0)
Then
Exit Do
'
' ---Handle case when
the OK or BACK button was selected
Else
'
' ---Get the first
item in the list
aValue =
userInfo.Item(1)
'
' ---Check if the
BACK button was selected
If (aValue =
"BACK_BUTTON") Then
'
' ---Reset the
index and counter values
jItem = jItem -
(itmPerGrp * 2)
If (jItem <
1) Then
jItem = -1
End If
iGroup = iGroup
- 2
If (iGroup <
0) Then
iGroup = 0
End If
'
' ---Handle case
when the OK button was selected
Else
'
' ---Set flag denoting no data error detected
jErr = 0
'
' ---Initialize
the error message
aMessage =
Empty
'
' ---Extract the
attribute and user entered value
For kk = 1 To
nItems
colStrng = entryList.Item(kk)
' ---Remove
the two characters added to the field name
colStrng =
Mid(colStrng, 1, Len(colStrng) - 2)
' ---Skip the
reserved attributes
If
(UCase(colStrng) = "OBJECTID") Then
theCol =
-1
ElseIf
(UCase(colStrng) = "SHAPE") Then
theCol =
-1
ElseIf
(UCase(colStrng) = "DISSOLVE_SHAPE") Then
theCol =
-1
ElseIf
(UCase(colStrng) = "FID") Then
theCol =
-1
ElseIf
(UCase(colStrng) = "OID") Then
theCol =
-1
ElseIf
(UCase(colStrng) = "SHAPE_AREA") Then
theCol =
-1
ElseIf (UCase(colStrng) =
"SHAPE_LENGTH") Then
theCol =
-1
ElseIf
(UCase(colStrng) = "SHAPE.AREA") Then
theCol =
-1
ElseIf
(UCase(colStrng) = "SHAPE.LENGTH") Then
theCol = -1
ElseIf
(UCase(colStrng) = "SHAPE.LEN") Then
theCol =
-1
ElseIf
(UCase(colStrng) = "FEATUREID") Then
theCol =
-1
ElseIf
(UCase(colStrng) = "ZORDER") Then
theCol =
-1
ElseIf
(UCase(colStrng) = "ANNOTATIONCLASSID") Then
theCol =
-1
ElseIf
(UCase(colStrng) = "ELEMENT") Then
theCol =
-1
Else
theCol =
0
End If
aValue =
userInfo.Item(kk)
col =
theFTab.FindField(colStrng)
' ---Make
sure the field exists and can be modified
If ((col
<> -1) And (theCol = 0) And (pField.Editable)) Then
Set
pField = theFTab.Field(col)
' ---Set
flag denoting data item okay
kErr = 0
'
---Remove any leading and trailing blanks
If (Not IsNull(aValue)) Then
bValue = Trim(aValue)
End If
' ---Check
for Date field
If
(pField.Type = esriFieldTypeDate) Then
If
((Len(bValue) > 1) And (bValue <> " ")) Then
If
(IsDate(bValue)) Then
pFeature.Value(col) = CDate(bValue)
Else
kErr = 1
jErr = jErr + 1
End If
End
If
' ---Check
for Double numeric fields
ElseIf
(pField.Type = esriFieldTypeDouble) Then
If
((Len(bValue) < 1) Or (bValue = " ")) Then
bValue = "0.0"
End
If
If
(IsNumeric(bValue)) Then
pFeature.Value(col) = CDbl(bValue)
Else
kErr = 1
jErr = jErr + 1
End
If
' ---Check
for Long integer numeric fields
ElseIf
(pField.Type = esriFieldTypeInteger) Then
If
((Len(bValue) < 1) Or (bValue = " ")) Then
bValue = "0"
End
If
If
(IsNumeric(bValue)) Then
pFeature.Value(col) = CLng(bValue)
Else
kErr = 1
jErr = jErr + 1
End
If
' ---Check
for Float numeric fields
ElseIf
(pField.Type = esriFieldTypeSingle) Then
If
((Len(bValue) < 1) Or (bValue = " ")) Then
bValue = "0.0"
End
If
If
(IsNumeric(bValue)) Then
pFeature.Value(col) = CSng(bValue)
Else
kErr = 1
jErr = jErr + 1
End
If
' ---Check
for Small integer numeric fields
ElseIf
(pField.Type = esriFieldTypeSmallInteger) Then
If
((Len(bValue) < 1) Or (bValue = " ")) Then
bValue = "0"
End
If
If
(IsNumeric(bValue)) Then
pFeature.Value(col) = CInt(bValue)
Else
kErr = 1
jErr = jErr + 1
End
If
' ---Check
for String or Character field
ElseIf
(pField.Type = esriFieldTypeString) Then
If
(Not IsNull(aValue)) Then
pFeature.Value(col) = aValue
Else
If
(pField.IsNullable) Then
pFeature.Value(col) = Null
End If
End If
End If
' ---Check
if data item contained an error
If (kErr
<> 0) Then
aMessage = aMessage + _
"Invalid " + colStrng + " specified: " + _
CStr(aValue) + Chr(13)
End If
End If
Next
'
' ---Update the
database
pFeature.Store
'
' ---Check if an
error was detected
If (jErr <> 0) Then
If (jErr =
1) Then
aMessage
= aMessage + "Original value maintained."
Else
aMessage
= aMessage + "Original values maintained."
End If
Call avMsgBoxWarning(aMessage,
Heading)
' ---Reset the
index and counter values
jItem =
jItem - itmPerGrp
If (jItem
< 1) Then
jItem =
-1
End If
iGroup = iGroup
- 1
If (iGroup
< 0) Then
iGroup =
0
End If
End If
End If
End If
'
' ---Define the operation
Call avStopOperation("Edit Feature")
'
' ---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: EditFeature")