One to many labeling

[NaseefChowdhury]

I know this is something we have been asking for forever, but I do not know if there is a real solution for this yet? Did anyone ever manage to recreate the "One to Many Label" script from VB6? Did ESRI finally give us a real solution to do the labeling? I saw one option of doing it using pivot tables that would require ArcInfo license, but that is a very roundabout solution using a license most people don't have. If anyone knows of a working solution please let me know.

If you don't know what I am talking about, basically I am looking to make "callout box" type of labels such as:

MW01   DEPTH   BENZENE   XYLENE
           12        34            0.78
           18        102           9

[RichardFairhurst]

Here is the second shot just to show it could deal with a lot of labels.  Please assign points to my posts by pressing the up arrow on the right side of each post above the number.

[JenniferHorsman2]

Here is some vbscript code I created to label using related (one-to-many) tables based on tips found here: http://www.esri.com/news/arcuser/1104/files/vbscript_label.pdf and here http://gisnuts.com/terra/blog/2012/05/16/label-features-with-attributes-from-related-records.
You must change the items in italics to suit your datasets. My relate table happened to be a .csv file. And I used a font (Lucida Console) in which every character is exactly the same width so that my numbers (see pic) would line up on the right.

Function FindLabel ( [RelateField] )
  iMaxLbl1Sz = 0
  iMaxLbl2Sz = 0
  iSpace = 3
  Set gp = CreateObject("esriGeoprocessing.GPDispatch.1")
  strWhereClause = chr(34) & "RelateFieldinTable" & chr(34) & " = '" & [RelateField] & "'" 
  strpTable = "path to your relate table"
  Set prows = gp.searchcursor(strpTable,strWhereClause)
  Set prow = prows.next
  Do until prow is nothing
  strLabel1 = prow.Depths
  strLabel2 = prow.TotalPAHs
  If (Len(strLabel1) > iMaxLbl1Sz) Then
    iMaxLbl1Sz = Len(strLabel1)
  End If
  If (Len(strLabel2) > iMaxLbl2Sz) Then
    iMaxLbl2Sz = Len(strLabel2)
  End If
  Set prow = prows.next
  Loop  FindLabel = "<UND>" & FindLabel & [RelateField] & "</UND>" & vbnewline
  Set prows = gp.searchcursor(strpTable,strWhereClause)
  Set prow = prows.next
  Do until prow is nothing
  strLabel1 = prow.Depths
  strLabel2 = prow.TotalPAHs
  k = (iMaxLbl1Sz - Len(strLabel1)) + iSpace + (iMaxLbl2Sz - Len(strLabel2))
  FindLabel = FindLabel & strLabel1 & String(k, ".") & strLabel2 & vbnewline
  Set prow = prows.next
  Loop
End Function

[JenniferHorsman2]

Here is another example that looks even more like a table. The text in bold italics must be modified to suit your data.
[ATTACH=CONFIG]29762[/ATTACH]
Again, I used a .csv file as my relate table.

Function FindLabel ( [RelateFieldOfLayer] )
  iMaxLbl1Sz = 0
  iMaxLbl2Sz = 0
  iSpace = 5
  Set gp = CreateObject("esriGeoprocessing.GPDispatch.1")
  strWhereClause = chr(34) & "RelateFieldOfTable" & chr(34) & " = '" & [RelateFieldOfLayer] & "'" 
  strpTable = "PathToRelateTable"

  Set prows = gp.searchcursor(strpTable,strWhereClause)
  Set prow = prows.next
  Do until prow is nothing
  strLabel1 = prow.LabelField1
  strLabel2 = prow.LabelField2
  If (Len(strLabel1) > iMaxLbl1Sz) Then
    iMaxLbl1Sz = Len(strLabel1)
  End If
  If (Len(strLabel2) > iMaxLbl2Sz) Then
    iMaxLbl2Sz = Len(strLabel2)
  End If
  Set prow = prows.next
  Loop

  FindLabel = FindLabel & "<FNT name='Arial' size='6.25'>" & [RelateFieldOfLayer] & "</FNT>" & vbnewline
  FindLabel = FindLabel & String(iMaxLbl1Sz + iMaxLbl2Sz + iSpace, "_") & vbnewline
  Set prows = gp.searchcursor(strpTable,strWhereClause)
  Set prow = prows.next
  Do until prow is nothing
  strLabel1 = prow.LabelField1
  strLabel2 = prow.LabelField2
  k1 = (iMaxLbl1Sz - Len(strLabel1)) + 2
  k2 = iSpace + (iMaxLbl2Sz - Len(strLabel2)) - 3
  FindLabel = FindLabel & strLabel1 & "<CLR red='255' green='255' blue='255'>" & String(k1, ".") & "</CLR>"
  FindLabel = FindLabel & "|"
  FindLabel = FindLabel & "<CLR red='255' green='255' blue='255'>" & String(k2, ".") & "</CLR>" & strLabel2 & vbnewline
  Set prow = prows.next
  Loop
End Function

[RichardFairhurst]

Jennifer:

Thanks for the code. I have modified it slightly to make it slightly easier to change the inputs of the script that need to be customized for user specific data by adding variables in the top lines of the Function. The field names still have to be modified in the body of the text. The inputs are shown in Red, Bold and Italics similar in your code.

I also modified the label style created by the code by eliminating the horizontal line inserted below the table header by using an underline of the header instead to reduce the amount of vertical space needed for each label. As you mentioned, the label font needs to have uniform spaced characters to work correctly.

Function FindLabel ( [RelateFieldOfLayer] )
  RelateFieldOfLayerValues = [RelateFieldOfLayer]
  RelateFieldOfLayer = "RelateFieldOfLayer"
  RelateFieldOfTable = "RelateFieldOfTable"
  strpTable = "PathToRelateTable"
  iMaxLbl1Sz = 0
  iMaxLbl2Sz = 0
  iSpace = 5
  Set gp = CreateObject("esriGeoprocessing.GPDispatch.1")
  strWhereClause = chr(34) & RelateFieldOfTable & chr(34) & " = '" & RelateFieldOfLayerValues & "'" 

  Set prows = gp.searchcursor(strpTable,strWhereClause)
  Set prow = prows.next
  Do until prow is nothing
  strLabel1 = prow.LabelField1
  strLabel2 = prow.LabelField2
  If (Len(strLabel1) > iMaxLbl1Sz) Then
    iMaxLbl1Sz = Len(strLabel1)
  End If
  If (Len(strLabel2) > iMaxLbl2Sz) Then
    iMaxLbl2Sz = Len(strLabel2)
  End If
  Set prow = prows.next
  Loop
  Set prows = Nothing

  FindLabel = FindLabel & "<UND>" & RelateFieldOfLayerValues & "</UND>" & String(iMaxLbl1Sz + iMaxLbl2Sz + iSpace - Len(RelateFieldOfLayerValues), "_") & vbnewline
  Set prows = gp.searchcursor(strpTable,strWhereClause)
  Set prow = prows.next
  Do until prow is nothing
  strLabel1 = prow.LabelField1
  strLabel2 = prow.LabelField2
  k1 = (iMaxLbl1Sz - Len(strLabel1)) + 2
  k2 = iSpace + (iMaxLbl2Sz - Len(strLabel2)) - 3
  FindLabel = FindLabel & strLabel1 & "<CLR red='255' green='255' blue='255'>" & String(k1, ".") & "</CLR>"
  FindLabel = FindLabel & "|"
  FindLabel = FindLabel & "<CLR red='255' green='255' blue='255'>" & String(k2, ".") & "</CLR>" & strLabel2 & vbnewline
  Set prow = prows.next
  Loop
  Set prows = Nothing
End Function

[JoymaxNascimento]

How would the "where" in string type primary keys?

Jennifer: 

Thanks for the code. I have modified it slightly to make it slightly easier to change the inputs of the script that need to be customized for user specific data by adding variables in the top lines of the Function. The field names still have to be modified in the body of the text. The inputs are shown in Red, Bold and Italics similar in your code. 

I also modified the label style created by the code by eliminating the horizontal line inserted below the table header by using an underline of the header instead to reduce the amount of vertical space needed for each label. As you mentioned, the label font needs to have uniform spaced characters to work correctly. 

Function FindLabel ( [RelateFieldOfLayer] )
  RelateFieldOfLayerValues = [RelateFieldOfLayer]
  RelateFieldOfLayer = "RelateFieldOfLayer"
  RelateFieldOfTable = "RelateFieldOfTable"
  strpTable = "PathToRelateTable"
  iMaxLbl1Sz = 0
  iMaxLbl2Sz = 0
  iSpace = 5
  Set gp = CreateObject("esriGeoprocessing.GPDispatch.1")
  strWhereClause = chr(34) & RelateFieldOfTable & chr(34) & " = '" & RelateFieldOfLayerValues & "'" 

  Set prows = gp.searchcursor(strpTable,strWhereClause)
  Set prow = prows.next
  Do until prow is nothing
  strLabel1 = prow.LabelField1
  strLabel2 = prow.LabelField2
  If (Len(strLabel1) > iMaxLbl1Sz) Then
    iMaxLbl1Sz = Len(strLabel1)
  End If
  If (Len(strLabel2) > iMaxLbl2Sz) Then
    iMaxLbl2Sz = Len(strLabel2)
  End If
  Set prow = prows.next
  Loop
  Set prows = Nothing

  FindLabel = FindLabel & "<UND>" & RelateFieldOfLayerValues & "</UND>" & String(iMaxLbl1Sz + iMaxLbl2Sz + iSpace - Len(RelateFieldOfLayerValues), "_") & vbnewline
  Set prows = gp.searchcursor(strpTable,strWhereClause)
  Set prow = prows.next
  Do until prow is nothing
  strLabel1 = prow.LabelField1
  strLabel2 = prow.LabelField2
  k1 = (iMaxLbl1Sz - Len(strLabel1)) + 2
  k2 = iSpace + (iMaxLbl2Sz - Len(strLabel2)) - 3
  FindLabel = FindLabel & strLabel1 & "<CLR red='255' green='255' blue='255'>" & String(k1, ".") & "</CLR>"
  FindLabel = FindLabel & "|"
  FindLabel = FindLabel & "<CLR red='255' green='255' blue='255'>" & String(k2, ".") & "</CLR>" & strLabel2 & vbnewline
  Set prow = prows.next
  Loop
  Set prows = Nothing
End Function

[RichardFairhurst]

How would the "where" in string type primary keys?

The code assumed the related field was a string field, because single quotes are surrounding the value in the where clause variable.

  strWhereClause = chr(34) & RelateFieldOfTable & chr(34) & " = '" & RelateFieldOfLayerValues & "'"

If the relate field was actually a numeric field the code would have to be changed to remove the single quotes from the line of code that builds the where clause.

  strWhereClause = chr(34) & RelateFieldOfTable & chr(34) & " = " & RelateFieldOfLayerValues

If this does not answer your question, please copy the specific lines of code into your message that you are concerned about to better help me understand your question.

[JoymaxNascimento]

In my case, just does not work.
Unable enteder why.


Function FindLabel ( [HOLEID] )
  RelateFieldOfLayerValues = [HOLEID]
  RelateFieldOfLayer = "HOLEID"
  RelateFieldOfTable = "HOLEID"
  strpTable = "A:\Desktop\New Folder\New Folder\BNDS.mdb\TEOR"
iMaxLbl1Sz = 10
  iMaxLbl2Sz = 0
  iSpace = 8
  Set gp = CreateObject("esriGeoprocessing.GPDispatch.1")
strWhereClause = chr(34) & RelateFieldOfTable & chr(34) & " = '" & RelateFieldOfLayerValues & "'"

  Set prows = gp.searchcursor(strpTable,strWhereClause)
  Set prow = prows.next
  Do until prow is nothing
  strLabel1 = prow.[HOLEID]
  strLabel2 = prow.[ATE]
  If (Len(strLabel1) > iMaxLbl1Sz) Then
    iMaxLbl1Sz = Len(strLabel1)
  End If
  If (Len(strLabel2) > iMaxLbl2Sz) Then
    iMaxLbl2Sz = Len(strLabel2)
  End If
  Set prow = prows.next
  Loop
  Set prows = Nothing

  FindLabel = FindLabel & "<UND>" & RelateFieldOfLayerValues & "</UND>" & String(iMaxLbl1Sz + iMaxLbl2Sz + iSpace - Len(RelateFieldOfLayerValues), "_") & vbnewline
  Set prows = gp.searchcursor(strpTable,strWhereClause)
  Set prow = prows.next
  Do until prow is nothing
  strLabel1 = prow.[HOLEID]
  strLabel2 = prow.[GEO]
  k1 = (iMaxLbl1Sz - Len(strLabel1)) + 2
  k2 = iSpace + (iMaxLbl2Sz - Len(strLabel2)) - 3
  FindLabel = FindLabel & strLabel1 & "<CLR red='0' green='0' blue='0'>" & String(k1, ".") & "</CLR>"
  FindLabel = FindLabel & "|"
  FindLabel = FindLabel & "<CLR red='0' green='0' blue='0'>" & String(k2, ".") & "</CLR>" & strLabel2 & vbnewline
  Set prow = prows.next
  Loop
  Set prows = Nothing
End Function


Just returned is the [HOLEID].[ATTACH=CONFIG]33821[/ATTACH]

[ATTACH=CONFIG]0[/ATTACH]

The code assumed the related field was a string field, because single quotes are surrounding the value in the where clause variable.

  strWhereClause = chr(34) & RelateFieldOfTable & chr(34) & " = '" & RelateFieldOfLayerValues & "'"

If the relate field was actually a numeric field the code would have to be changed to remove the single quotes from the line of code that builds the where clause.

  strWhereClause = chr(34) & RelateFieldOfTable & chr(34) & " = " & RelateFieldOfLayerValues

If this does not answer your question, please copy the specific lines of code into your message that you are concerned about to better help me understand your question.

[RichardFairhurst]

The field names for the cursor are not supposed to be surrounded by brackets.  (I would have put brackets in my example around the red text if I meant for you to enter a field name within brackets for the lines of code below)

Change this:

  strLabel1 = prow.[HOLEID]
  strLabel2 = prow.[ATE]

to this:

  strLabel1 = prow.HOLEID
  strLabel2 = prow.ATE

Both sets of these lines of code have to be identical.  You have to use ATE or both have to use GEO for the second field.  Or else both sets could be:

  strLabel1 = prow.ATE
  strLabel2 = prow.GEO

HoleID will be included in the header line built by this line of code:

  FindLabel = FindLabel & "<UND>" & RelateFieldOfLayerValues & "</UND>" & String(iMaxLbl1Sz + iMaxLbl2Sz + iSpace - Len(RelateFieldOfLayerValues), "_") & vbnewline

HOLEID should be a text field to work with this where clause and should not have Null values.

Function FindLabel ( [HOLEID] )
  RelateFieldOfLayerValues = [HOLEID]
  RelateFieldOfLayer = "HOLEID"
  RelateFieldOfTable = "HOLEID"
  strpTable = "A:\Desktop\New Folder\New Folder\BNDS.mdb\TEOR"
iMaxLbl1Sz = 10
  iMaxLbl2Sz = 0
  iSpace = 8
  Set gp = CreateObject("esriGeoprocessing.GPDispatch.1")
strWhereClause = chr(34) & RelateFieldOfTable & chr(34) & " = '" & RelateFieldOfLayerValues & "'"

  Set prows = gp.searchcursor(strpTable,strWhereClause)
  Set prow = prows.next
  Do until prow is nothing
  strLabel1 = prow.ATE
  strLabel2 = prow.GEO
  If (Len(strLabel1) > iMaxLbl1Sz) Then
    iMaxLbl1Sz = Len(strLabel1)
  End If
  If (Len(strLabel2) > iMaxLbl2Sz) Then
    iMaxLbl2Sz = Len(strLabel2)
  End If
  Set prow = prows.next
  Loop
  Set prows = Nothing

  FindLabel = FindLabel & "<UND>" & RelateFieldOfLayerValues & "</UND>" & String(iMaxLbl1Sz + iMaxLbl2Sz + iSpace - Len(RelateFieldOfLayerValues), "_") & vbnewline
  Set prows = gp.searchcursor(strpTable,strWhereClause)
  Set prow = prows.next
  Do until prow is nothing
  strLabel1 = prow.ATE
  strLabel2 = prow.GEO
  k1 = (iMaxLbl1Sz - Len(strLabel1)) + 2
  k2 = iSpace + (iMaxLbl2Sz - Len(strLabel2)) - 3
  FindLabel = FindLabel & strLabel1 & "<CLR red='0' green='0' blue='0'>" & String(k1, ".") & "</CLR>"
  FindLabel = FindLabel & "|"
  FindLabel = FindLabel & "<CLR red='0' green='0' blue='0'>" & String(k2, ".") & "</CLR>" & strLabel2 & vbnewline
  Set prow = prows.next
  Loop
  Set prows = Nothing
End Function

[JoymaxNascimento]

It did not work.
Is to write the "where" directly?

The field names for the cursor are not supposed to be surrounded by brackets.  (I would have put brackets in my example around the red text if I meant for you to enter a field name within brackets for the lines of code below)

Change this:

  strLabel1 = prow.[HOLEID]
  strLabel2 = prow.[ATE]

to this:

  strLabel1 = prow.HOLEID
  strLabel2 = prow.ATE

HOLEID should be a text field to work with this where clause and should not have Null values.

Function FindLabel ( [HOLEID] )
  RelateFieldOfLayerValues = [HOLEID]
  RelateFieldOfLayer = "HOLEID"
  RelateFieldOfTable = "HOLEID"
  strpTable = "A:\Desktop\New Folder\New Folder\BNDS.mdb\TEOR"
iMaxLbl1Sz = 10
  iMaxLbl2Sz = 0
  iSpace = 8
  Set gp = CreateObject("esriGeoprocessing.GPDispatch.1")
strWhereClause = chr(34) & RelateFieldOfTable & chr(34) & " = '" & RelateFieldOfLayerValues & "'"

  Set prows = gp.searchcursor(strpTable,strWhereClause)
  Set prow = prows.next
  Do until prow is nothing
  strLabel1 = prow.HOLEID
  strLabel2 = prow.ATE
  If (Len(strLabel1) > iMaxLbl1Sz) Then
    iMaxLbl1Sz = Len(strLabel1)
  End If
  If (Len(strLabel2) > iMaxLbl2Sz) Then
    iMaxLbl2Sz = Len(strLabel2)
  End If
  Set prow = prows.next
  Loop
  Set prows = Nothing

  FindLabel = FindLabel & "<UND>" & RelateFieldOfLayerValues & "</UND>" & String(iMaxLbl1Sz + iMaxLbl2Sz + iSpace - Len(RelateFieldOfLayerValues), "_") & vbnewline
  Set prows = gp.searchcursor(strpTable,strWhereClause)
  Set prow = prows.next
  Do until prow is nothing
  strLabel1 = prow.HOLEID
  strLabel2 = prow.GEO
  k1 = (iMaxLbl1Sz - Len(strLabel1)) + 2
  k2 = iSpace + (iMaxLbl2Sz - Len(strLabel2)) - 3
  FindLabel = FindLabel & strLabel1 & "<CLR red='0' green='0' blue='0'>" & String(k1, ".") & "</CLR>"
  FindLabel = FindLabel & "|"
  FindLabel = FindLabel & "<CLR red='0' green='0' blue='0'>" & String(k2, ".") & "</CLR>" & strLabel2 & vbnewline
  Set prow = prows.next
  Loop
  Set prows = Nothing
End Function

[RichardFairhurst]

It did not work.
Is to write the "where" directly?

You have no basis for thinking the "where" is the problem.  The code works when the inputs are correct, otherwise I could not have made the screenshot.  The only problems are tied to the inputs you are supplying.  Your path is likely the problem.  The backslash is an escape character and not being interpreted as a backslash.  You must make it a raw string to correct that.

  strpTable = r"A:\Desktop\New Folder\New Folder\BNDS.mdb\TEOR"

You can reference a table that is already in your map without using any path and it will work.  So add TEOR to the map and make the path:

  strpTable = "TEOR"

You also did not make the two sets of field pairs identical.  That is corrected below where I assumed you wanted ATE and GEO listed as paired values under the HOLEID header.

Function FindLabel ( [HOLEID] )
  RelateFieldOfLayerValues = [HOLEID]
  RelateFieldOfLayer = "HOLEID"
  RelateFieldOfTable = "HOLEID"
  strpTable = r"A:\Desktop\New Folder\New Folder\BNDS.mdb\TEOR"
iMaxLbl1Sz = 10
  iMaxLbl2Sz = 0
  iSpace = 8
  Set gp = CreateObject("esriGeoprocessing.GPDispatch.1")
strWhereClause = chr(34) & RelateFieldOfTable & chr(34) & " = '" & RelateFieldOfLayerValues & "'"

  Set prows = gp.searchcursor(strpTable,strWhereClause)
  Set prow = prows.next
  Do until prow is nothing
  strLabel1 = prow.ATE
  strLabel2 = prow.GEO
  If (Len(strLabel1) > iMaxLbl1Sz) Then
    iMaxLbl1Sz = Len(strLabel1)
  End If
  If (Len(strLabel2) > iMaxLbl2Sz) Then
    iMaxLbl2Sz = Len(strLabel2)
  End If
  Set prow = prows.next
  Loop
  Set prows = Nothing

  FindLabel = FindLabel & "<UND>" & RelateFieldOfLayerValues & "</UND>" & String(iMaxLbl1Sz + iMaxLbl2Sz + iSpace - Len(RelateFieldOfLayerValues), "_") & vbnewline
  Set prows = gp.searchcursor(strpTable,strWhereClause)
  Set prow = prows.next
  Do until prow is nothing
  strLabel1 = prow.ATE
  strLabel2 = prow.GEO
  k1 = (iMaxLbl1Sz - Len(strLabel1)) + 2
  k2 = iSpace + (iMaxLbl2Sz - Len(strLabel2)) - 3
  FindLabel = FindLabel & strLabel1 & "<CLR red='0' green='0' blue='0'>" & String(k1, ".") & "</CLR>"
  FindLabel = FindLabel & "|"
  FindLabel = FindLabel & "<CLR red='0' green='0' blue='0'>" & String(k2, ".") & "</CLR>" & strLabel2 & vbnewline
  Set prow = prows.next
  Loop
  Set prows = Nothing
End Function