'MacroName:CutterTableP-PZ40
'MacroDescription:Creates a cutter for use with Table P-PZ40
'
' This macro was written by Walter F. Nickeson,
' University of Rochester, Rochester, NY
' wnickeson@library.rochester.edu
'
' Last updated: 22 May 2006.
' Check for the latest versions of this and my other macros at
' http://docushare.lib.rochester.edu/docushare/dsweb/View/Collection-2556
' Please e-mail me with bug reports or to suggest improvements.
'
' Works in Connexion client 2.10.
'
'****************************************************************
' How it works: This macro calculates a Cutter for works of
' general criticism for authors of one cutter, according to LC
' Table P-PZ40, which squeezes the whole alphabet into the
' numbers 5 to 999. Select a text string to be cuttered and run
' the macro. The macro will generate a (quick and dirty) two- to
' four-character LC cutter in the range Z5-Z999, based on the
' first few characters of the selection, ignoring punctuation
' and diacritics. This Cutter is also copied to the Windows
' Clipboard for pasting in at the appropriate place. Be sure to
' adjust the suggested Cutter to fit your own shelflist!
'
' Cuttering based on LC practice as posted on AUTOCAT, 24 April
' 1998.
'****************************************************************

Option Explicit

Sub Main

Dim CS as Object
Set CS = CreateObject("Connex.Client")

Dim Char$
Dim Cutter$                  : Cutter$ = "Z"
Dim CutterString$            : CutterString$ = ""
Dim Text$

Dim BaseAddition%
Dim BaseNumber%
Dim Character%               : Character% = 1
Dim Check%
Dim Counter%                 : Counter% = 1
Dim FirstCutter%
Dim SecondCutter%

Dim FirstInClass             : FirstInClass = FALSE

If CS.GetSelectedText(Text$) = FALSE Then
    MsgBox "No text is selected!"
    Exit Sub
End If

' Build the string by getting the first two letters of the word.
' Convert the characters to uppercase for manipulation

Do
  Char$ = Mid$( Text$, Character% )
  Check% = Asc(Char$)
  Select Case Check%
    Case 32
    ' If the cursor is on a space, and this loop of the macro is just
    ' starting, keep searching to the right until a character is reached;
    ' otherwise assume the end of the word has been encountered and
    ' create the Cutter
      If Counter% > 1 Then
          GoTo Continue:
        Else
          Counter% = 1
      End If
    Case 39   'Skip an apostrophe
    Case 65 to 90
      CutterString$ = CutterString$ + Chr$(Check%)
      Counter% = Counter% + 1
    Case 97 to 122
      CutterString$ = CutterString$ + Chr$(Check% - 32)
      Counter% = Counter% + 1
    Case Else
    ' If the cursor is on punctuation or a non-alphabetic character, and
    ' this loop of the macro is just starting, end the macro with a warning
    ' that a Cutter cannot be created; otherwise assume the end of the word
    ' has been encountered and create the Cutter
      If Counter% = 1 Then
          Beep
          MsgBox "Cannot create Cutter from this character.", 48, "Cutter creation failed"
          Exit Sub
        Else
          GoTo Continue:
      End If
  End Select
  Character% = Character% + 1
  If Character% > Len( Text$ ) Then GoTo Continue:
  Char$ = ""
Loop Until Counter% = 3

Continue:

FirstCutter% = Asc(Left(CutterString$, 1))

' Special provision must be made if the character string is one character
' long

If Len(CutterString$) > 1 Then
    SecondCutter% = Asc(Mid(CutterString$, 2, 1))
  Else
    SecondCutter% = 0
End If

' Get the first number of the Cutter by breaking the alphabet into groups
' to cover the range of available numbers (more or less 600 to 999); make
' note of the first letter in each group, as it gets special treatment if
' the word to be cuttered consists only of that letter

Select Case FirstCutter%
  Case 67 to 72
    BaseNumber% = 600
    If FirstCutter% = 67 Then FirstInClass = TRUE
  Case 73 to 78
    BaseNumber% = 700
    If FirstCutter% = 73 Then FirstInClass = TRUE
  Case 79 to 84
    BaseNumber% = 800
    If FirstCutter% = 79 Then FirstInClass = TRUE
  Case 85 to 90
    BaseNumber% = 900
    If FirstCutter% = 85 Then FirstInClass = TRUE
End Select

' Begin creating the second number of the Cutter by spreading the letters
' of each group evenly over the range of numbers available to that group
' (essentially, x00-x99), so each letter has its own domain of 15 numbers

Select Case FirstCutter%
  Case 68, 74, 80, 86
    BaseAddition% = 25
  Case 69, 75, 81, 87
    BaseAddition% = 40
  Case 70, 76, 82, 88
    BaseAddition% = 55
  Case 71, 77, 83, 89
    BaseAddition% = 70
  Case 72, 78, 84, 90
    BaseAddition% = 85
End Select

' First letters A and B are special cases

Select Case FirstCutter%
  Case 65
    Select Case SecondCutter%
      Case 0
        Cutter$ = Cutter$ + "5"
      Case 65 to 70
        Cutter$ = Cutter$ + "51"
      Case 71 to 76
        Cutter$ = Cutter$ + "52"
      Case 77 to 83
        Cutter$ = Cutter$ + "53"
      Case 84 to 90
        Cutter$ = Cutter$ + "54"
    End Select
  Case 66
    Select Case SecondCutter%
      Case 65 to 69
        Cutter$ = Cutter$ + "55"
      Case 70 to 74
        Cutter$ = Cutter$ + "56"
      Case 75 to 79
        Cutter$ = Cutter$ + "57"
      Case 80 to 84
        Cutter$ = Cutter$ + "58"
      Case 85 to 89
        Cutter$ = Cutter$ + "59"
    End Select

' All remaining letters: Complete the second and third numbers of the Cutter
' by dividing the alphabet (for the second character of the word) into the
' 15-number range alotted to the first character (but only 12 numbers are
' used, to avoid somewhat Cutters ending in 0)

  Case 67 to 90
    Select Case SecondCutter%
      Case 0
        If FirstInClass = TRUE Then
            Cutter$ = Left$((Cutter$ + Trim(Str$(BaseNumber% + BaseAddition%))), 2)
          Else
            Cutter$ = Cutter$ + Trim(Str$(BaseNumber% + BaseAddition%))
            If Right$(Cutter$, 1) = "0" Then
                Cutter$ = Left$(Cutter$, 3)
            End If
        End If
      Case 65 to 66
        Cutter$ = Cutter$ + Trim(Str$(BaseNumber% + BaseAddition% + 1))
      Case 67 to 68
        Cutter$ = Cutter$ + Trim(Str$(BaseNumber% + BaseAddition% + 2))
      Case 69 to 70
        Cutter$ = Cutter$ + Trim(Str$(BaseNumber% + BaseAddition% + 3))
      Case 71 to 72
        Cutter$ = Cutter$ + Trim(Str$(BaseNumber% + BaseAddition% + 4))
      Case 73 to 74
        Cutter$ = Cutter$ + Trim(Str$(BaseNumber% + BaseAddition% + 6))
      Case 75 to 76
        Cutter$ = Cutter$ + Trim(Str$(BaseNumber% + BaseAddition% + 7))
      Case 77 to 78
        Cutter$ = Cutter$ + Trim(Str$(BaseNumber% + BaseAddition% + 8))
      Case 79 to 80
        Cutter$ = Cutter$ + Trim(Str$(BaseNumber% + BaseAddition% + 9))
      Case 81 to 82
        Cutter$ = Cutter$ + Trim(Str$(BaseNumber% + BaseAddition% + 11))
      Case 83 to 84
        Cutter$ = Cutter$ + Trim(Str$(BaseNumber% + BaseAddition% + 12))
      Case 85 to 87
        Cutter$ = Cutter$ + Trim(Str$(BaseNumber% + BaseAddition% + 13))
      Case 88 to 90
        Cutter$ = Cutter$ + Trim(Str$(BaseNumber% + BaseAddition% + 14))
    End Select
End Select

Finish:

Cutter$ = Trim( Cutter$ )
Clipboard.Clear
Clipboard.SetText Cutter$
MsgBox Cutter$, 0, "Cutter created and copied to the Clipboard"

End Sub