Attribute VB_Name = "SyncTitleBlock"
' ---------------------------------------------------------------------------
' SyncTitleBlock - MicroStation V8i macro for OSP basemap drawings.
'
' Edit the title block tags on ANY one sheet (double-click > Edit Tags), then,
' while that sheet is still open, run:   vba run SyncTitleBlock
' Every other sheet's title block (and the title page) is updated to match.
'
' SHEET, SCALE and TOTAL_SHEETS are per-page and are never copied.
' ---------------------------------------------------------------------------
Option Explicit

Private Const SKIP_TAGS As String = "|SHEET|SCALE|TOTAL_SHEETS|"
Private Const MARKER_TAG As String = "PROJECT"   ' every builder title block has it

Public Sub SyncTitleBlock()
    Dim source As Element
    Set source = FindTitleBlock(ActiveModelReference)
    If source Is Nothing Then
        MsgBox "No title block found on this sheet (" & ActiveModelReference.Name & ")." & vbCrLf & _
               "Open the sheet you edited, then run SyncTitleBlock again.", vbExclamation, "SyncTitleBlock"
        Exit Sub
    End If

    ' Values from the sheet you edited, by tag name.
    Dim names() As String, values() As String, count As Long
    Dim srcTags() As TagElement, i As Long
    srcTags = source.GetTags
    ReDim names(UBound(srcTags)): ReDim values(UBound(srcTags))
    For i = LBound(srcTags) To UBound(srcTags)
        If InStr(SKIP_TAGS, "|" & UCase$(srcTags(i).TagDefinitionName) & "|") = 0 Then
            names(count) = UCase$(srcTags(i).TagDefinitionName)
            values(count) = CStr(srcTags(i).Value)
            count = count + 1
        End If
    Next i

    Dim model As ModelReference, target As Element
    Dim tags() As TagElement, j As Long, k As Long
    Dim sheetsDone As Long, changes As Long
    For Each model In ActiveDesignFile.Models
        If model.Name <> ActiveModelReference.Name Then
            Set target = FindTitleBlock(model)
            If Not target Is Nothing Then
                tags = target.GetTags
                For j = LBound(tags) To UBound(tags)
                    For k = 0 To count - 1
                        If UCase$(tags(j).TagDefinitionName) = names(k) Then
                            If CStr(tags(j).Value) <> values(k) Then
                                tags(j).Value = values(k)
                                tags(j).Rewrite
                                changes = changes + 1
                            End If
                            Exit For
                        End If
                    Next k
                Next j
                sheetsDone = sheetsDone + 1
            End If
        End If
    Next model

    MsgBox "Updated " & changes & " value(s) on " & sheetsDone & _
                " other sheet(s) from " & ActiveModelReference.Name & ".", vbInformation, "SyncTitleBlock"
End Sub

' The cell on this sheet that carries the title block tags, or Nothing.
Private Function FindTitleBlock(model As ModelReference) As Element
    Dim ee As ElementEnumerator, el As Element
    Dim tags() As TagElement, i As Long
    Set ee = model.Scan
    Do While ee.MoveNext
        Set el = ee.Current
        If el.HasAnyTags Then
            tags = el.GetTags
            For i = LBound(tags) To UBound(tags)
                If UCase$(tags(i).TagDefinitionName) = MARKER_TAG Then
                    Set FindTitleBlock = el
                    Exit Function
                End If
            Next i
        End If
    Loop
End Function