Domains from existing attributes.

I know there is an option to automatically create new Domains when adding a table to a model, but is there a way to add domains from attributes that do not already have domains after the table has been added?

  • Here's a macro that will do that with the Logical model.  I found that it works better in the Logical model since domain datatypes are logical. 

     

    3513.Create Domains from logical model.txt
    'TITLE:  Create Domains
    'DESCRIPTION:  Loop through the logical model and creates domains for each column based off attribute name
    '              This will maintain nullibility of the column.
    '              Definitions and notes will not be added to the domain.  Override bound data option will be checked
    '              and the original Definitions and Notes will be maintained.
    
    'ER/Studio Variables
    Dim diag As Diagram
    Dim mdl As Model
    
    Dim ent As Entity
    
    Dim dict As Dictionary
    
    Sub Main
    	Debug.Clear
    	Dim att As AttributeObj
    	Dim I As Integer
    	Dim myDomain As Domain
    
    	Set diag = DiagramManager.ActiveDiagram
    	' Use only the logical model
    	Set mdl = diag.Models.Item("Logical")
    	Set dict = diag.Dictionary
    
    	For Each ent In mdl.Entities
    		For Each att In ent.Attributes
    			' if the attribute is a FK then ignore it. It will get the parent details.
    			If Not att.ForeignKey Then
    			' if the attribute is not bound to a domain
    			If att.DomainId = 0 Then
    				Dim DomName As String
    				I = 0
    				While True
    					' If this is the first time we're getting a domain
    					' then the name doesn't contain _<number>
    					If I = 0 Then
    						DomName = att.AttributeName
    					Else
    						' Domain will end with _<number>
    						DomName = att.AttributeName & "_" & I
    					End If
    						' get the domain based on the name above.
    					Set myDomain = dict.Domains.Item(DomName)
    
    					' domain is empty, so no more domains with the same name.
    					If myDomain Is Nothing Then
    						createDomain(att, DomName)
    						Exit While
    					End If
    
    					' check if the attribute is the same as the domain
    					If isSame (myDomain, att) Then
    						'bind domain to attribute
    						bindDomain(myDomain, att)
    						Exit While
    					Else
    						I = I + 1
    					End If
    				Wend
    				End If ' domain id
    			End If ' foreign key
    		Next
    	Next
    MsgBox "Done"
    	
    End Sub
    
    ' function to compare domain with attribute and return true or false
    ' ignores notes, definition and null option
    Private Function isSame(dom As Domain, att As AttributeObj) As Boolean
    
    	If UCase(dom.CheckConstraint) <> UCase(att.CheckConstraint) Then GoTo NotSame
    	If UCase(dom.ColumnName) <> UCase(att.ColumnName) Then GoTo NotSame
    	' if the data length is less than 0 then this may be a custom attribute.
    	' Ignore the data length
    	If att.DataLength >= 0 Then
    		If dom.DataLength <> att.DataLength Then GoTo NotSame
    	End If
    
    	' if data scale is less than 0 then this may be a custom attribute.
    	' ignore the data length
    	If att.DataScale >= 0 Then
    		If dom.DataScale <> att.DataScale Then GoTo NotSame
    	End If
    	If UCase(dom.Datatype) <> UCase(att.Datatype) Then GoTo NotSame
    	If UCase(dom.DeclaredDefault) <> UCase(att.DeclaredDefault) Then GoTo NotSame
    	If att.DefaultId > 0 Then
    		If dom.DefaultId <> att.DefaultId Then GoTo NotSame
    	End If
    	If dom.Identity <> att.Identity Then GoTo NotSame
    	' if the attribute is an identity column then compare the increment and seed
    	If att.Identity Then
    		If dom.IdentityIncrement <> att.IdentityIncrement Then GoTo NotSame
    		If dom.IdentitySeed <> att.IdentitySeed Then GoTo NotSame
    	End If
    	If att.ReferenceValueId > 0 Then
    		If dom.ReferenceValueId <> att.ReferenceValueId Then GoTo NotSame
    	End If
    	If att.RuleId > 0 Then
    		If dom.RuleId <> att.RuleId Then GoTo NotSame
    	End If
    	If att.UserDatatypeId > 0 Then
    		If dom.UserDatatypeId <> att.UserDatatypeId Then GoTo NotSame
    	End If
    		isSame = True
    		Exit Function
    
    	NotSame:
    		isSame = False
    		Exit Function
    
    End Function
    
    ' create a Domain with the same details as the attribute
    ' ignore definitions, notes and null option.
    Private Sub createDomain(att As AttributeObj, DomName As String)
    	Dim dom As Domain
    
    	dict.Domains.Add(DomName, att.ColumnName)
    	Set dom = dict.Domains.Item(DomName)
    
    	dom.AttributeName = att.AttributeName
    	dom.CheckConstraint = att.CheckConstraint
    	dom.ColumnName = att.ColumnName
    	dom.Datatype = att.Datatype
    	If att.DataLength >= 0 Then
    		dom.DataLength = att.DataLength
    	End If
    	If att.DataScale >= 0 Then
    		dom.DataScale = att.DataScale
    	End If
    
    
    
    	dom.DeclaredDefault = att.DeclaredDefault
    	If att.DefaultId > 0 Then
    		dom.DefaultId = att.DefaultId
    	End If
    	dom.Identity = att.Identity
    	' if the attribute is an identity column then copy the increment and seed
    	If att.Identity Then
    		dom.IdentityIncrement = att.IdentityIncrement
    		dom.IdentitySeed = att.IdentitySeed
    	End If
    
    	If att.ReferenceValueId > 0 Then
    		dom.ReferenceValueId = att.ReferenceValueId
    	End If
    	If att.RuleId > 0 Then
    		dom.RuleId = att.RuleId
    	End If
    	If att.UserDatatypeId > 0 Then
    		dom.UserDatatypeId = att.UserDatatypeId
    	End If
    
    	bindDomain(dom, att)
    End Sub
    
    ' bind the domain to the attribute.  Maintain attribute's nullibility
    ' Maintain notes and definitions and use the override bound data option
    Private Sub bindDomain(dom As Domain, att As AttributeObj)
    	Dim nullOption As String
    	Dim notes As String
    	Dim definitions As String
    	Dim datatype As String
    
    
    	' keep a copy of the notes, definitions and null option
    	notes = att.Notes
    	definitions = att.Definition
    	nullOption = att.NullOption
    
    	' Bind the domain to the attribute
    	att.DomainId = dom.ID
    
    	att.NullOption = nullOption
    	' enable override for definitions
    	att.EnableOverride(5, True)
    	' enable override for notes
    	att.EnableOverride(6, True)
    	att.Notes = notes
    	att.Definition = definitions
    
    
    End Sub
    

  • In reply to Stanley Chan:

    That worked. Thank you very much.