Macros – Quickly update the Dimensional Model Table Types

Introduction

Many different models and notations are supported by ER/Studio Data Architect. A model has one of these 2 model notations:

• Relational
• Dimensional

Model notations

When we use a Dimensional diagram, there’s an additional tab available in the Table editor: Dimensional

Dimensional tab

We can select the Dimensional Model Table Type and the Table Type and Data Architect updates how the diagram objects are displayed:

Dimensional model example

In this blog post, I’ll share a macro which replaces the Dimensional Model Table Type and the Table Type for all the Tables|Entities or a selected subset.

Script

'#Language "WWB-COM"
'
' Macro: Change Dimensional Model Table Type and Table Type
'	for all or selected entities|tables
'
' Version: 1.0
'***********************************************************************************

Option Explicit

Const TITLE$= "Change Dimensional Model Table Type and Table Type"

'ER.Studio variables
Dim theDiagram As Diagram
Dim theModel As Model
Dim theSubModel As SubModel
Dim optionTableSelection As Integer

Dim aType As Variant	' Dimensional Model Table Types
Dim aTType As Variant	' Table types for most Dimensional Model Table Types
Dim aFType As Variant	' Table types for Fact entities|tables
Dim aUType As Variant	' "Empty" table type for Undefined

'Array variable
Dim theSelectedTableCollection%()

Sub Main()
	
	' Dimensional Model Table Types
	aType = Array("Dimension","Fact","Snowflake","Bridge","Hierarchy Navigation","Undefined")
	aTType = Array("Fixed Dimension","Degenerate","Multi-Valued","Ragged","Shrunken","Slowly Changing Type 0","Slowly Changing Type 1","Slowly Changing Type 2","Slowly Changing Type 3","Slowly Changing Type 6")
	aFType = Array("Aggregate","Atomic","Cumulative","Snapshot","[none]")
	aUType = Array("")

	Begin Dialog UserDialog 500,210,"Change Dimensional Model Table Type",.DDLDialogFunc ' %GRID:10,7,1,1
		Text 20,17,100,14,"New Type:",.tType,1
		DropListBox 130,14,370,119,aType(),.cbType
		Text 20,45,100,14,"New Table Type:",.tTType,1
		DropListBox 130,42,370,119,aTType(),.cbTType
		GroupBox 20,91,470,70,"Table Selection",.grpBoxTableSelection
		OptionGroup .opGroupBoxTableSelection
			OptionButton 50,112,220,14,"Selected Tables",.opSelectedTables
			OptionButton 50,133,90,14,"All Tables",.opAllTables
		PushButton 30,182,90,21,"Change",.btnChange
		CancelButton 390,182,90,21,.btnExit
	End Dialog

	Debug.Clear

	Dim dlg As UserDialog

	Set theDiagram = DiagramManager.ActiveDiagram
	Set theModel = theDiagram.ActiveModel
	Set theSubModel = theModel.ActiveSubModel

   	If Dialog(dlg) = 0 Then
   		End
   	End If

End Sub

Function DDLDialogFunc(DlgItem$, Action%, SuppValue&) As Boolean
	
	Dim iType%, iTType%

	If Action% = 2 Then	' Value changing or button pressed
		Select Case DlgItem$
			Case "btnChange"
				iType = DlgValue("cbType")
				iTType = DlgValue "cbTType"
				optionTableSelection = DlgValue("opGroupBoxTableSelection")

				doGenerate(iType, iTType)

				DDLDialogFunc = False
			Case "btnExit"
				DDLDialogFunc = False
			Case "cbType"
				If DlgValue("cbType") = 1 Then 
					DlgListBoxArray "cbTType",aFType
					DlgValue "cbTType", 0
				ElseIf DlgValue("cbType") = 5 Then
					DlgListBoxArray "cbTType",aUType
					DlgValue "cbTType", 0
				Else
					DlgListBoxArray "cbTType",aTType
					DlgValue "cbTType", 0
				End If
				
				DDLDialogFunc = True
		End Select
	End If

End Function

Function AddArrNoDup(theCollection() As Integer, value As Integer)
	
	Dim I As Integer
	Dim nCount As Integer
	Dim bFound As Boolean

	If (value = 0) Then
		Exit Function
	End If

	Err.Clear
	On Error Resume Next
	nCount = UBound(theCollection)
	If ( Err.Number <> 0 ) Then
		Exit Function
	End If

	bFound = False
	For I = LBound(theCollection) To nCount
		If ( theCollection(I) = value ) Then
			bFound = True
			Exit For
		End If
	Next I

	If Not bFound Then
		For I = LBound(theCollection) To nCount
			If (theCollection(I) = 0) Then
				theCollection(I) = value
				Exit For
			End If
		Next I
	End If

End Function

Function GetIndexOf(collection() As Integer, value As Integer) As Integer
	
	Dim I As Integer
	Dim nCount As Integer

	GetIndexOf = -1

	Err.Clear
	On Error Resume Next
	nCount = UBound(collection)
	If (Err.Number <> 0) Then
		Exit Function
	End If

	For I = LBound(collection) To nCount
		If (collection(I) = value) Then
			GetIndexOf = I
			Exit Function
		End If
	Next I

End Function

Function AddToCollection(collection() As Integer, value As Integer)
	
	Dim nCount As Integer

	Err.Clear
	On Error Resume Next
	nCount = UBound(collection)
	If (Err.Number <> 0) Then
		nCount = 1
		ReDim collection(nCount)
	Else
		nCount = nCount + 1
		ReDim Preserve collection(nCount)
	End If
	collection(nCount) = value

End Function

Function ResizeCollection(theCollection As Variant)
	
	Dim I As Integer
	Dim nCount As Integer

	On Error Resume Next
	If (UBound(theCollection) < 1) Then
		Exit Function
	End If

	For I = LBound(theCollection) To UBound(theCollection)
		If ( (theCollection(I) = 0) Or (theCollection(I) = "") ) Then
			nCount = I
			Exit For
		End If
	Next I

	If (nCount > 1) Then
		ReDim Preserve theCollection(nCount - 1)
	End If

End Function

Function GetSelectedTables()
	
	Dim theCurEntity As Entity
	Dim so As SelectedObject
	Dim nCount As Integer
	Dim I As Integer

	Select Case optionTableSelection
		Case 0
			For Each so In theSubModel.SelectedObjects
				If (so.Type = 1) Then
					Set theCurEntity = theModel.Entities(so.ID)
					AddArrNoDup(theSelectedTableCollection, theCurEntity.ID)
				End If
			Next so
		Case 1
			For Each theCurEntity In theModel.Entities
				AddArrNoDup(theSelectedTableCollection, theCurEntity.ID)
			Next theCurEntity
	End Select

	ResizeCollection(theSelectedTableCollection) 

End Function

Function doGenerate(iType%, iTType%)

	If (theModel.Entities.Count > 0) Then
		ReDim theSelectedTableCollection(theModel.Entities.Count)
		GetSelectedTables()
	End If

	ChangeDimensionalModelTableType(iType, iTType)

End Function

Function UCFirst(txt As String) As String
	
	UCFirst = UCase(Left(txt, 1)) & LCase(Mid(txt, 2, Len(txt) - 1))

End Function

Function CleanDMTT(txt As String) As String
	
	CleanDMTT = UCFirst(txt)

	If CleanDMTT = "Navigation" Then
		CleanDMTT = "Hierarchy Navigation"
	End If

End Function

Function DMTTValue(iType  As Integer) As String
	
	DMTTValue = UCase(aType(iType))

	If DMTTValue = "HIERARCHY NAVIGATION" Then
		DMTTValue = "NAVIGATION"
	End If

End Function

Function DTTValue$(iType, iTType)

	Select iType
		Case 1		' Fact
			DTTValue = UCase(aFType(iTType))
		Case 5		' Undefined
			DTTValue = ""
		Case Else	' Others
			DTTValue = UCase(aTType(iTType))
	End Select

	If DTTValue = "FIXED DIMENSION" Then
		DTTValue = "FIXED"
	ElseIf DTTValue = "MULTI-VALUED" Then
		DTTValue = "MULTIVALUE"
	ElseIf DTTValue = "[NONE]" Then
		DTTValue = "[none]"
	ElseIf Left(DTTValue, 6) = "SLOWLY" Then
		DTTValue = "TYPE" & Mid(DTTValue, 22, 1)
	End If

End Function

Function ChangeDimensionalModelTableType(iType%, iTType%)
	
	Dim I As Integer
	Dim theEntity As Entity
	Dim upperBound As Integer
	Dim cpt As Integer

	cpt = 0

	On Error Resume Next

	upperBound = UBound(theSelectedTableCollection)

	If (Err.Number = 0) Then
		
		For I = LBound(theSelectedTableCollection) To upperBound
			
			Set theEntity = theModel.Entities(theSelectedTableCollection(I))

			If Not theEntity Is Nothing Then
				
				Debug.Print theEntity.TableName & ": " & CleanDMTT(theEntity.DimModelTableType) & " -> " & aType(iType)
				theEntity.DimModelTableType = DMTTValue(iType)
				theEntity.DimensionTableType = DTTValue(iType, iTType)

				cpt += 1

			End If

		Next I

	End If

	MsgBox "Dimensional Model Table Type and Table Type changed" & vbCrLf & cpt, vbInformation, TITLE

End Function

As usual, feel free to update the code to get your custom requirements.

Usage

• Optional: Select the Tables you want to update
• Run the macro
• Select the new Dimensional Model Table Type and the Table Type
• Choose if you want to apply the new values to all Tables or only to the selected ones
• Finally, click the Change button to update your objects.

Macro’s UI

Bonus

A short video which shows how to create a macro from a script in ER/Studio Data Architect: