Many different models and notations are supported by ER/Studio Data Architect. A model has one of these 2 model notations:
When we use a Dimensional diagram, there’s an additional tab available in the Table editor: Dimensional
We can select the Dimensional Model Table Type and the Table Type and Data Architect updates how the diagram objects are displayed:
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.
'#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.
A short video which shows how to create a macro from a script in ER/Studio Data Architect:
