One to many labeling

NaseefChowdhury · ‎09-10-2013

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

JoymaxNascimento · ‎05-14-2014

Remains the same.
I can send you the. "Mdb" for you to check?

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

RichardFairhurst · ‎05-14-2014

Remains the same.
I can send you the. "Mdb" for you to check?

Here is the code I use to build my labels. X_Y_LINK is a text field. There are no NULL values in any of the data. The related table named CL_INTERSECTIONS_PAIRS was already in my map. PAIR_STNAMES is a text field and INT_SPREAD is a double field in the related table. The inputs I changed to fit my data are shown in red.

I did modify the code slightly to handle an error that occurs if the header is longer than the detail value pairs or where there are no related records in the relate table. My previous test of my header line revision did not cover these possibilities. The revised lines that corrected the error are shown in bold green italics. The bold green italic lines did not need customization to fit the input data, they just needed to be added.

Function FindLabel ( [X_Y_LINK] )
  RelateFieldOfLayerValues = [X_Y_LINK]
  RelateFieldOfLayer = "X_Y_LINK"
  RelateFieldOfTable = "X_Y_LINK"
  strpTable = "CL_INTERSECTIONS_PAIRS"
  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.PAIR_STNAMES
  strLabel2 = prow.INT_SPREAD
  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

  if iMaxLbl1Sz + iMaxLbl2Sz + iSpace - Len(RelateFieldOfLayerValues) > 0 Then
    FindLabel = FindLabel & "<UND>" & RelateFieldOfLayerValues & "</UND>" & String(iMaxLbl1Sz + iMaxLbl2Sz + iSpace - Len(RelateFieldOfLayerValues), "_") & vbnewline
  Else
 FindLabel = FindLabel & "<UND>" & RelateFieldOfLayerValues & "</UND>" & vbnewline
 End If
  Set prows = gp.searchcursor(strpTable,strWhereClause)
  Set prow = prows.next
  Do until prow is nothing
  strLabel1 = prow.PAIR_STNAMES
  strLabel2 = prow.INT_SPREAD
  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 · ‎05-14-2014

Perfect, thank you.
One more thing, is presented in table form? with rows and columns perfect?
Mine were not with correct alignment.

Here is the code I use to build my labels. X_Y_LINK is a text field. There are no NULL values in any of the data. The related table named CL_INTERSECTIONS_PAIRS was already in my map. PAIR_STNAMES is a text field and INT_SPREAD is a double field in the related table. The inputs I changed to fit my data are shown in red.

I did modify the code slightly to handle an error that occurs if the header is longer than the detail value pairs or where there are no related records in the relate table. My previous test of my header line revision did not cover these possibilities. The revised lines that corrected the error are shown in bold green italics. The bold green italic lines did not need customization to fit the input data, they just needed to be added.

Function FindLabel ( [X_Y_LINK] )
  RelateFieldOfLayerValues = [X_Y_LINK]
  RelateFieldOfLayer = "X_Y_LINK"
  RelateFieldOfTable = "X_Y_LINK"
  strpTable = "CL_INTERSECTIONS_PAIRS"
  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.PAIR_STNAMES
  strLabel2 = prow.INT_SPREAD
  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

  if iMaxLbl1Sz + iMaxLbl2Sz + iSpace - Len(RelateFieldOfLayerValues) > 0 Then
    FindLabel = FindLabel & "<UND>" & RelateFieldOfLayerValues & "</UND>" & String(iMaxLbl1Sz + iMaxLbl2Sz + iSpace - Len(RelateFieldOfLayerValues), "_") & vbnewline
  Else
 FindLabel = FindLabel & "<UND>" & RelateFieldOfLayerValues & "</UND>" & vbnewline
 End If
  Set prows = gp.searchcursor(strpTable,strWhereClause)
  Set prow = prows.next
  Do until prow is nothing
  strLabel1 = prow.PAIR_STNAMES
  strLabel2 = prow.INT_SPREAD
  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 · ‎05-14-2014

Perfect, thank you.
One more thing, is presented in table form? with rows and columns perfect?
Mine were not with correct alignment.

Did you use a uniform width font like Lucidia Console? You could also try Courior, Courier New, Letter Gothic Std, OCR A Std, Orator Std, Prestige Elite Std, and Simplified Arabic Fixed. Only fonts where every letter is the same width will come close to working.

Fonts like Arial won't work, because the character widths vary too much. There is no way to control letter spacing of variable width character fonts to make a decent looking table.

If the font does not fix the problem I would need to see a screen shot of what you are seeing. If the header row width is longer than your value pairs the spacing algorithm would need to be adjusted slightly to account for the extra width.

Anyway, no matter what they probably won't be perfect. If you look carefully at my screen shot the vertical separators do vary slightly, but the variance is not enough to make the table layout fail. Since these labels remain dynamic the fact that they only achieve a reasonable table effect with minor imperfections is a decent trade off over other methods that may achieve perfect tables, but that require the labels to become static.

RichardFairhurst · ‎05-14-2014

Perfect, thank you.

If my responses have been helpful please up vote the posts that helped you out. See this link for more information.

JoymaxNascimento · ‎05-17-2014

I changed the font you suggested, but still with different tabs.
Masked name for confidentiality reasons.[ATTACH=CONFIG]33889[/ATTACH]

Did you use a uniform width font like Lucidia Console? You could also try Courior, Courier New, Letter Gothic Std, OCR A Std, Orator Std, Prestige Elite Std, and Simplified Arabic Fixed. Only fonts where every letter is the same width will come close to working.

Fonts like Arial won't work, because the character widths vary too much. There is no way to control letter spacing of variable width character fonts to make a decent looking table.

If the font does not fix the problem I would need to see a screen shot of what you are seeing. If the header row width is longer than your value pairs the spacing algorithm would need to be adjusted slightly to account for the extra width.

Anyway, no matter what they probably won't be perfect. If you look carefully at my screen shot the vertical separators do vary slightly, but the variance is not enough to make the table layout fail. Since these labels remain dynamic the fact that they only achieve a reasonable table effect with minor imperfections is a decent trade off over other methods that may achieve perfect tables, but that require the labels to become static.

RichardFairhurst · ‎05-17-2014

I changed the font you suggested, but still with different tabs.
Masked name for confidentiality reasons.[ATTACH=CONFIG]33889[/ATTACH]

It looks like you have 4 fields in your layout. I would have to see your code for how you created those columns, since the code was not designed for more than 2 fields. I would not expect the 4 fields to align correctly without significant code modification. So are you now happy with what you got? It appears your first column needs more space to deal with all values being less than 4 characters long. Anyway, getting column headers and values to align was not part of the code I really changed or examined. It does not appear to have a sophisticated enough algorithm to automatically adapt to any set of value and column name lengths.

Actually, I knew the code does not create alignments of the column headers relative to the values, so I am not surprised by the results. I would like to see your code before trying to make the header value alignment algorithm better.

JoymaxNascimento · ‎01-22-2016

Sorry for the delay, changed the code like this::

Function FindLabel ( [HOLEID] )

RelateFieldOfLayerValues = [HOLEID]

RelateFieldOfLayer = "HOLEID"

RelateFieldOfTable = "HOLEID"

strpTable = "DADO"

iMaxLbl1Sz = 0

iMaxLbl2Sz = 0

iMaxLbl3Sz =0

iMaxLbl4Sz = 0

iSpace = 3

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.DE

strLabel2 = prow.INTERV

strLabel3 = prow.Fe_pct

strLabel4 = prow.GEO

If (Len(strLabel1) > iMaxLbl1Sz) Then

iMaxLbl1Sz = Len(strLabel1)

End If

If (Len(strLabel2) > iMaxLbl2Sz) Then

iMaxLbl2Sz = Len(strLabel2)

End If

If (Len(strLabel3) > iMaxLbl3Sz) Then

iMaxLbl3Sz = Len(strLabel3)

End If

If (Len(strLabel4) > iMaxLbl4Sz) Then

iMaxLbl4Sz = Len(strLabel4)

End If

Set prow = prows.next

Loop

Set prows = Nothing

if iMaxLbl1Sz + iMaxLbl2Sz + iMaxLbl3Sz + iMaxLbl4Sz + iSpace - Len(RelateFieldOfLayerValues) > 0 Then

'FindLabel = FindLabel & "<UND>" & RelateFieldOfLayerValues & "</UND>" & String(14, "_") & vbnewline

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

Else

FindLabel = FindLabel & "<UND>" & RelateFieldOfLayerValues & "</UND>" & vbnewline

FindLabel = FindLabel & "<UND>" & "<CLR red='0' green='0' blue='255'>" & "|"& "FROM(m)"& "|"&"INT(m)"& vbtab & "|"&"Fe(%)" &"|"&"LIT"& "</CLR>"& "</UND>"& vbnewline

End If

Set prows = gp.searchcursor(strpTable,strWhereClause)

Set prow = prows.next

Do until prow is nothing

strLabel1 = prow.DE

strLabel2 = prow.INTERV

strLabel3 = prow.Fe_pct

strLabel4 = prow.GEO

k1 = iSpace + (iMaxLbl1Sz - Len(strLabel1))

k2 = iSpace + (iMaxLbl2Sz - Len(strLabel2))

k3 = iSpace + (iMaxLbl3Sz - Len(strLabel3))

k4 = iSpace + (iMaxLbl4Sz - Len(strLabel4)) -3

FindLabel = FindLabel & "|"

FindLabel = FindLabel & strLabel1 & "<CLR red='255' green='255' blue='210'>" & String(k1, ".") & "</CLR>"

FindLabel = FindLabel & "|"

FindLabel = FindLabel & strLabel2 & "<CLR red='255' green='255' blue='210'>" & String(k2, ".") & "</CLR>"

FindLabel = FindLabel & "|"

FindLabel = FindLabel & strLabel3 & "<CLR red='255' green='255' blue='210'>" & String(k3, ".") & "</CLR>"

FindLabel = FindLabel & "|"

FindLabel = FindLabel & "<CLR red='255' green='255' blue='210'>" & String(k4, ".") & "</CLR>" & strLabel4 & "|" &vbnewline

Set prow = prows.next

Loop

Set prows = Nothing

End Function