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)

'

'  ---Define the record to be processed

   rec = 12

'

'  ---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)

'

'  ---Make the theme editable

   Call avSetEditable(pmxDoc, theTheme, true)

'

'  ---Delete all features in the theme

   Call avRemoveRecord(pmxDoc, theTheme, -2)

'

'  ---Make the theme not editable

   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)

'

'  ---Make the theme editable

   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)

'

'  ---Make the theme not editable

   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)

'

'  ---Define the record to be processed

   rec = 12

'

'  ---Make the theme editable

   Call avSetEditable(pmxDoc, theTheme, true)

'

'  ---Delete the specific record in the theme

   Call avRemoveRecord(pmxDoc, theTheme, rec)

'

'  ---Make the theme not editable

   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)

'

'  ---Define the record to be processed

   rec = 12

'

'  ---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)

'

'  ---Make the table editable

   Call avSetEditable(pmxDoc, theTable, true)

'

'  ---Delete all records in the table

   Call avRemoveRecord(pmxDoc, theTable, -2)

'

'  ---Make the table not editable

   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)

'

'  ---Make the table editable

   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)

'

'  ---Make the table not editable

   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)

'

'  ---Define the record to be processed

   rec = 12

'

'  ---Make the table editable

   Call avSetEditable(pmxDoc, theTable, true)

'

'  ---Delete the specific record in the table

   Call avRemoveRecord(pmxDoc, theTable, rec)

'

'  ---Make the table not editable

   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

   Dim theFTab As IFields

   Dim pFeatCls As IFeatureClass

   Dim pLayer As IFeatureLayer

   Dim col1 As Long, col2 As Long, rec As Long

'

'  ---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 fields and record to be processed

   col1 = theFTab.FindField("MAP")

   col2 = theFTab.FindField("PNT")

   rec = 12

'

'  ---Make the theme editable

   Call avSetEditable(pmxDoc, "L_0ln", true)

'

'  ---Store the value, 24, in record 12 of the theme

   Call avSetValue(pmxDoc, "L_0ln", col1, rec, 24)

'

'  ---Store the value, 100, in record 12 of the theme

   Call avSetValue(pmxDoc, "L_0ln", col2, rec, 100)

'

'  ---Write the record to disk, to improve performance avSetValue will

'  ---not store any data until the StoreRec keyword is passed

   Call avSetValue(pmxDoc, "L_0ln", col2, rec, "StoreRec")

'

'  ---Make the theme not editable

   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

   Dim theVTab As IFields

   Dim col1 As Long, col2 As Long, rec As Long

'

'  ---Get the active view

   Call avGetActiveDoc(pMxApp, pmxDoc, pActiveView, pMap)

'

'  ---Get the virtual table for a table called aTable

   Call avGetVTab(pmxDoc, "aTable", theVTab)

'

'  ---Define the fields and record to be processed

   col1 = theVTab.FindField("MAP")

   col2 = theVTab.FindField("PNT")

   rec = 12

'

'  ---Make the table editable

   Call avSetEditable(pmxDoc, "aTable", true)

'

'  ---Store the value, 24, in record 12 of the table

   Call avSetValue(pmxDoc, "aTable", col1, rec, 24)

'

'  ---Store the value, 100, in record 12 of the table

   Call avSetValue(pmxDoc, "aTable", col2, rec, 100)

'

'  ---Write the record to disk, to improve performance avSetValue will

'  ---not store any data until the StoreRec keyword is passed

   Call avSetValue(pmxDoc, "aTable", col2, rec, "StoreRec")

'

'  ---Make the table not editable

   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

   Dim theFTab As IFields

   Dim pFeatCls As IFeatureClass, pLayer As IFeatureLayer

   Dim col As Long

   Dim recList As New Collection

   Dim total As Double, iRec As Long, rec As Long

   Dim pFeat As IFeature

   Dim deposit 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("Deposits")

'

'  ---Get a list of OIDs for the theme

   Call avGetFTabIDs(pmxDoc, "L_0ln", recList)

'

'  ---Cycle thru the OIDs adding the Deposits value for each

'  ---feature to a cumalative value (total)

   total = 0#

   For iRec = 1 to recList.Count

'      ---Get the OID for the feature

       rec = recList.Item(iRec)

'      ---Get the IFeature interface for the feature

       Set pFeat = pFeatCls.GetFeature(rec)

'      ---Get the deposit value

       deposit = pFeat.Value(col)

'      ---Add the value to the cumalative variable

       total = total + deposit

   Next

 

 

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

      Loop

'

'     ---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

   Dim theVTab As IFields

   Dim col As Long

   Dim recList As New Collection

   Dim total As Double, iRec As Long, rec As Long

   Dim pRow As IRow

   Dim deposit As Double

'

'  ---Get the active view

   Call avGetActiveDoc(pMxApp, pmxDoc, pActiveView, pMap)

'

'  ---Get the virtual table for a table called aTable

   Call avGetVTab(pmxDoc, "aTable", theVTab)

'

'  ---Define the field to be processed

   col = theVTab.FindField("Deposits")

'

'  ---Get a list of OIDs for the table

   Call avGetVTabIDs(pmxDoc, "aTable", recList)

'

'  ---Cycle thru the OIDs adding the Deposits value for each

'  ---record to a cumalative value (total)

   total = 0#

   For iRec = 1 to recList.Count

'      ---Get the OID for the record

       rec = recList.Item(iRec)

'      ---Get the IRow interface for the record

       Call avGetTableRow(pmxDoc, "aTable", rec, pRow)

'      ---Get the deposit value stored in the record

       deposit = pRow.Value(col)

'      ---Add the value to the cumalative variable

       total = total + deposit

   Next

 

 

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

   Dim theVTab As IFields

   Dim col As Long

   Dim sel As ISelectionSet, selList As New Collection

   Dim total As Double, iRec As Long, rec As Long

   Dim pRow As IRow

   Dim deposit As Double

'

'  ---Get the active view

   Call avGetActiveDoc(pMxApp, pmxDoc, pActiveView, pMap)

'

'  ---Get the virtual table for a table called aTable

   Call avGetVTab(pmxDoc, "aTable", theVTab)

'

'  ---Define the field to be processed

   col = theFTab.FindField("Deposits")

'

'  ---Get the selected set for the table

   Call avGetSelection(pmxDoc, "aTable", sel)

'

'  ---Get a list of the OIDs for the selected records in the table

   Call avGetSelectionIDs(sel, selList)

'

'  ---Cycle thru the selected set adding the Deposits value for each

'  ---selected record to a cumalative value (total)

   total = 0#

   For iRec = 1 to selList.Count

       rec = selList.Item(iRec)

       Call avGetTableRow(pmxDoc, "aTable", rec, pRow)

       deposit = pRow.Value(col)

       total = total + deposit

   Next

 

 

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

   Loop

'

'  ---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 theFTab As IFields

   Dim pFeatCls As IFeatureClass, pLayer As IFeatureLayer

   Dim col As Long

   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)

'

'  ---Define the field to be processed

   col = theFTab.FindField("Deposits")

'

'  ---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

                  Loop

               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

                  Loop

               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 = "Reading the file " + aFileName + "..."

   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)

'

'  ---Loop until all data entered properly or user aborts

   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)

   Loop

'

'  ---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")

'

'  ---Sort one collection in an ascending order without displaying

'  ---a progress bar

   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:
4:54 PM 15 Sep 2003
   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

   Loop

 

 

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

             Loop

          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

   Loop

'

'  ---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)