One to many labeling

10629
27
Jump to solution
09-10-2013 12:51 PM
NaseefChowdhury
New Contributor II
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
Tags (2)
27 Replies
RichardFairhurst
MVP Honored Contributor
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.
0 Kudos
JenniferHorsman2
New Contributor II
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
New Contributor II
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
MVP Honored Contributor
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
New Contributor
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
0 Kudos
RichardFairhurst
MVP Honored Contributor
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.
0 Kudos
JoymaxNascimento
New Contributor
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.
0 Kudos
RichardFairhurst
MVP Honored Contributor
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
0 Kudos
JoymaxNascimento
New Contributor
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
0 Kudos
RichardFairhurst
MVP Honored Contributor
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
0 Kudos