Home › Tripcevich PhD Diss › Ch5 Methods › 5.10. Database structure and 1:M labeling

5.10.2. VB Script for One-to-Many labeling

Labeling through a 1:M relationship is not currently supported in ESRI Arcmap 9.1. To resolve this limitation, the script presented below iterates through all the artifacts collected from a given spatial location and places their values in a text box. Text boxes can then be converted to annotation and moved around the map as needed.


' This command is issued from the Label Properties "Text String" Expression, and with the Advanced button checked.

' In this case Feature:ARCH_ID and Table:Arch_ID are Strings and they hold an ID common to both records in both

' the Feature, and the Table Litico_II is the name of the table C:\gis_data\colca_data\colca.mdb is an MDB or GDB

'Recursive Label function for labeling 1:Many from a table in a Access / GDB file.

' Modified from code by Mohammed Hoque 2005 in http://www.esri.com/news/arcuser/0705/files/externaldb.pdf

Function FindLabel ( [ARCHID] )

Dim strLblQry, strInfo

' strLblQry = "SELECT * FROM Litico_II WHERE ArchID = '" & [ARCHID] &"'"

' if ARCHID were a String then the line would look like the above

strLblQry = "SELECT * FROM Litico_II WHERE ArchID = " & [ARCHID]

Dim ADOConn

set ADOConn = createobject("ADODB.Connection")

Dim rsLbls

set rsLbls = createObject("ADODB.Recordset")

ADOConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\gis_data\colca_data\colca.mdb;"

rsLbls.Open strLblQry, ADOConn, 3, 1, 1

'If no record is found, return label only

Select Case rsLbls.RecordCount

Case -1, 0 ' no matching records in table

strInfo = "A03-" & [ARCHID] & "." & trim(rsLbls.Fields("Rot_Inicio").Value) & ": No Artifact Data!"

Case 1 ' just one matching record

if cint(rsLbls.Fields("Diag14").Value) > 0 then ' checks before labelling this record

If cint(rsLbls.Fields("Rot_Inicio").Value) = 1 then

' Don't show Dot-Rotulo for only one label

strInfo = "" & [ARCHID] & ""

Else strInfo = "" & [ARCHID] & "." & trim(rsLbls.Fields("Rot_Inicio").Value) & ""

End if

' use the TRIM function so that no error is returned in case of NULL

End If

Case Else

'Loop through all records in Table with same Arch_ID

Dim i

For i = 0 to rsLbls.RecordCount + 1

if cint(rsLbls.Fields("Diag14").Value) > 0 then ' checks to see if we should label this record

strInfo = strInfo & "" & [ARCHID] & "." & trim(rsLbls.Fields("Rot_Inicio").Value) & ""

end if

i = i + 1

rsLbls.MoveNext

Next

End Select

'closing connections, this is a must

rsLbls.Close

ADOConn.Close

Set rsLbls = Nothing

Set ADOConn = Nothing

FindLabel = strInfo ' This is where the string is returned for labeling

End Function

Table 5-12. Script for labeling through a One-To-Many relate in ArcMap 9.1.

Cartographic capabilities of future GIS software likely will include a similar feature in the symbology and labeling function. Table restructuring merely to represent relationships that are inherent to the database structure, as is currently required by the off-the-shelf software, is highly inefficient.