Automatically trace elements to domain model in Enterprise Architect

This script will search the text in the comments, scenario’s and linked document of the selected elements for terms in the domain model. If it finds a match it will create a trace from your selected element to the element in the domain model.

The idea is that when we write descriptions and scenario’s we often use terms already defined in the domain model, so it would be good if we had a real trace from the element in the domain model and the element using it in its description.

But it is hard to keep the descriptions and scenario’s in sync with the traces to the domain model. This script does the hard part for us and keeps those traces in sync. All you need to do is type your description and run the script. The script will find the referenced elements in the domain model and create a trace link to it. It will also remove any automatic traces that are not valid anymore.

Next to the Name, Notes, and the Linked Document, this script will also search the scenarios, both the Scenario Description, as the structured Scenario Steps. In case of a Scenario Step the script will insert to the name of the domain model element in the Uses column.

Note that the script is case sensitive. That is the reason why RoomType does not appear in the uses column. Enterprise Architect itself isn’t that picky, and it underlines Roomtype anyway because it finds a relationship to RoomType.

In order to execute the script you have to select either one or more elements in the project browser, or select a package in the project browser.

Then select Script|Link To Domain Model

Free download

The script

In the first part we ask the user to select the domain model package.
If you want to use this script on a particular model you may want to replace that by a hard coding the Domain models GUID into the script.
Since this script may run for a while on a large model, we also create an output tab so we can inform the user of our progress.

sub main
	'let the user select the domain model package
	dim response
	response = Msgbox ("Please select the domain model package", vbOKCancel+vbQuestion, "Selecte domain model")
	if response = vbOK then
		
		dim domainModelPackage as EA.Package
		set domainModelPackage = selectPackage()
		if not domainModelPackage is nothing then
			Repository.CreateOutputTab "Link to Domain Model"
			Repository.ClearOutput "Link to Domain Model"
			Repository.EnsureOutputVisible "Link to Domain Model"
			'link selected elements to the domain model elements
			linkSelectionToDomainModel(domainModelPackage)
			'tell the user we are done
			Repository.WriteOutput "Link to Domain Model", "Finished!", 0
		end if
	end if
end sub

Next we create a dictionary of all classes in domain model package and all of the sub-packages recursively.

	'first get the pattern from all the classes in the domain model
	dim dictionary
	Set dictionary = CreateObject("Scripting.Dictionary")
	
	'create domain model dictionary
	'tell the user what we are doing
	Repository.WriteOutput "Link to Domain Model", "Creating domain model dictionary", 0
	addToClassDictionary domainModelPackage.PackageGUID, dictionary

Based on this dictionary we can create one large Regular Expression that will tell us which of the terms in the dictionary are used in a certain text.

	' and prepare the regex object
	dim pattern
	'create the pattern based on the names in the dictionary
	pattern = createRegexPattern(dictionary)
	Dim regExp  
	Set regExp = CreateObject("VBScript.RegExp")
	regExp.Global = True   
	regExp.IgnoreCase = False
	regExp.Pattern = pattern

Then we check what is selected in the project browser. If the user has selected one or more elements we start process those elements. If a package is selected then we process the elements in the selected package.

	' Get the type of element selected in the Project Browser
	dim treeSelectedType
	treeSelectedType = Repository.GetTreeSelectedItemType()
	' Either process the selected Element, or process all elements in the selected package
	select case treeSelectedType
		case otElement
			' Code for when an element is selected
			dim selectedElements as EA.Collection
			set selectedElements = Repository.GetTreeSelectedElements()
			'link the selected elements with the 
			linkDomainClassesWithElements dictionary,regExp,selectedElements 
		case otPackage
			' Code for when a package is selected
			dim selectedPackage as EA.Package
			set selectedpackage = Repository.GetTreeSelectedObject()
			'link use domain classes with the elements in the selected package
			linkDomainClassesWithElementsInPackage dictionary, regExp,selectedPackage
		case else
			' Error message
			Session.Prompt "You have to select Elements or a Package", promptOK
	end select

Here’s the complete code for the script.

option explicit
!INC Local Scripts.EAConstants-VBScript
'
' Script Name: Link to Domain Model
' Author: Geert Bellekens
' Purpose: Link elements with classes in the domain model based on their name.
' Date: 15/11/2015
'

sub main
	'let the user select the domain model package
	dim response
	response = Msgbox ("Please select the domain model package", vbOKCancel+vbQuestion, "Selecte domain model")
	if response = vbOK then
		
		dim domainModelPackage as EA.Package
		set domainModelPackage = selectPackage()
		if not domainModelPackage is nothing then
			Repository.CreateOutputTab "Link to Domain Model"
			Repository.ClearOutput "Link to Domain Model"
			Repository.EnsureOutputVisible "Link to Domain Model"
			'link selected elements to the domain model elements
			linkSelectionToDomainModel(domainModelPackage)
			'tell the user we are done
			Repository.WriteOutput "Link to Domain Model", "Finished!", 0
		end if
	end if
end sub
'this is the actual call to the main function
main
function linkSelectionToDomainModel(domainModelPackage)
	'first get the pattern from all the classes in the domain model
	dim dictionary
	Set dictionary = CreateObject("Scripting.Dictionary")
	
	'create domain model dictionary
	'tell the user what we are doing
	Repository.WriteOutput "Link to Domain Model", "Creating domain model dictionary", 0
	addToClassDictionary domainModelPackage.PackageGUID, dictionary
	
	'tell the user what we are doing
	Repository.WriteOutput "Link to Domain Model", "Interpreting dictionary", 0
	' and prepare the regex object
	dim pattern
	'create the pattern based on the names in the dictionary
	pattern = createRegexPattern(dictionary)
	Dim regExp  
	Set regExp = CreateObject("VBScript.RegExp")
	regExp.Global = True   
	regExp.IgnoreCase = False
	regExp.Pattern = pattern
	
	' Get the type of element selected in the Project Browser
	dim treeSelectedType
	treeSelectedType = Repository.GetTreeSelectedItemType()
	' Either process the selected Element, or process all elements in the selected package
	select case treeSelectedType
		case otElement
			' Code for when an element is selected
			dim selectedElements as EA.Collection
			set selectedElements = Repository.GetTreeSelectedElements()
			'link the selected elements with the 
			linkDomainClassesWithElements dictionary,regExp,selectedElements 
		case otPackage
			' Code for when a package is selected
			dim selectedPackage as EA.Package
			set selectedpackage = Repository.GetTreeSelectedObject()
			'link use domain classes with the elements in the selected package
			linkDomainClassesWithElementsInPackage dictionary, regExp,selectedPackage
		case else
			' Error message
			Session.Prompt "You have to select Elements or a Package", promptOK
	end select
end function
'this function will get all elements in the given package and subpackages recursively and link them to the domain classes
function linkDomainClassesWithElementsInPackage(dictionary,regExp,selectedPackage)
	dim packageList 
	set packageList = getPackageTree(selectedPackage)
	dim packageIDString
	packageIDString = makePackageIDString(packageList)
	dim getElementsSQL
	getElementsSQL = "select o.Object_ID from t_object o where o.Package_ID in (" & packageIDString & ")"
	dim usecases
	set usecases = getElementsFromQuery(getElementsSQL)
	linkDomainClassesWithElements dictionary,regExp,usecases
end function

function linkDomainClassesWithElements(dictionary,regExp,elements)
	dim element as EA.Element
	'loop de elements
	for each element in elements
		'tell the user what we are doing
		Repository.WriteOutput "Link to Domain Model", "Linking element: " & element.Name, 0
		'first remove all automatic traces
		removeAllAutomaticTraces element
		'match based on notes and linked document
		dim elementText
		'get full text (name +notes + linked document + scenario names + scenario notes)
		elementText = element.Name
		elementText = elementText & vbNewLine & Repository.GetFormatFromField("TXT",element.Notes)
		elementText = elementText & vbNewLine & getLinkedDocumentContent(element, "TXT")
		elementText = elementText & vbNewLine & getTextFromScenarios(element)
		dim matches
		set matches = regExp.Execute(elementText)
		'for each match create a «trace» link with the element
		linkMatchesWithelement matches, element, dictionary
		'link based on text in scenariosteps
		dim scenario as EA.Scenario
		'get all dependencies left
		dim dependencies
		set dependencies = getDependencies(element)
		'loop scenarios
		for each scenario in element.Scenarios
			dim scenarioStep as EA.ScenarioStep
			for each scenarioStep in scenario.Steps
				'first remove any additional terms in the uses field
				scenarioStep.Uses = removeAddionalUses(dependencies, scenarioStep.Uses)
				set matches = regExp.Execute(scenarioStep.Name)
				dim classesToMatch 
				set classesToMatch = getClassesToMatchDictionary(matches, dictionary)
				dim classToMatch as EA.Element
				for each classToMatch in classesToMatch.Items
					if not instr(scenarioStep.Uses,classToMatch.Name) > 0 then
						scenarioStep.Uses = scenarioStep.Uses & " " & classToMatch.Name
					end if
					'create the dependency between the use case and the domain model class
					linkElementsWithAutomaticTrace element, classToMatch
				next
				'save scenario step
				scenarioStep.Update
				scenario.Update
			next
		next
	next
end function
function linkMatchesWithelement(matches, element, dictionary)
	dim classesToMatch
	'get the classes to match
	Set classesToMatch = getClassesToMatchDictionary(matches,dictionary)
	dim classToMatch as EA.Element
	'actually link the classes
	for each classToMatch in classesToMatch.Items
		linkElementsWithAutomaticTrace element, classToMatch
	next
end function

'get the text from the scenarios name and notes
function getTextFromScenarios(element)
	dim scenario as EA.Scenario
	dim scenarioText
	scenarioText = "" 
	for each scenario in element.Scenarios
		scenarioText = scenarioText & vbNewLine & scenario.Name
		scenarioText = scenarioText & vbNewLine & Repository.GetFormatFromField("TXT",scenario.Notes)
	next
	getTextFromScenarios = scenarioText
end function
function removeAddionalUses(dependencies, uses)
	dim dependency
	dim filteredUses
	filteredUses = ""
	if len(uses) > 0 then
		for each dependency in dependencies.Keys
			if Instr(uses,dependency) > 0 then
				if len(filteredUses) > 0 then
					filteredUses = filteredUses & " " & dependency
				else
					filteredUses = dependency
				end if
			end if
		next
	end if
	removeAddionalUses = filteredUses
end function
'returns a dictionary of elements with the name as key and the element as value.
function getDependencies(element)
	dim getDependencySQL
	getDependencySQL =  "select dep.Object_ID from ( t_object dep " & _
						" inner join t_connector con on con.End_Object_ID = dep.Object_ID)   " & _
						" where con.Connector_Type = 'Dependency'  " & _
						" and con.Start_Object_ID = " & element.ElementID   
	set getDependencies = getElementDictionaryFromQuery(getDependencySQL)
end function
function removeAllAutomaticTraces(element)
		dim i
		dim connector as EA.Connector
		'remove all the traces to domain model classes
		for i = element.Connectors.Count -1 to 0 step -1
			set connector = element.Connectors.GetAt(i)
			if connector.Alias = "automatic" and connector.Stereotype = "trace" then
				element.Connectors.DeleteAt i,false 
			end if
		next
end function
function getClassesToMatchDictionary(matches, allClassesDictionary)
	dim match
	dim classesToMatch
	dim className
	Set classesToMatch = CreateObject("Scripting.Dictionary")
	'create list of elements to link
	For each match in matches
		if not allClassesDictionary.Exists(match.Value) then
			'strip the last 's'
			className = left(match.Value, len(match.Value) -1)
		else
			className = match.Value
		end if
		if not classesToMatch.Exists(className) then
			classesToMatch.Add className, allClassesDictionary(className)
		end if
	next
	set getClassesToMatchDictionary = classesToMatch
end function
'Create a «trace» relation between source and target with "automatic" as alias
function linkElementsWithAutomaticTrace(sourceElement, targetElement)
	dim linkExists 
	linkExists = false
	'first make sure there isn't already a trace relation between the two
	dim existingConnector as EA.Connector
	'make sure we are using the up-to-date connectors collection
	sourceElement.Connectors.Refresh
	for each existingConnector in sourceElement.Connectors
		if existingConnector.SupplierID = targetElement.ElementID _
		   and existingConnector.Stereotype = "trace" then
		   linkExists = true
		   exit for
		end if
	next
	if not linkExists then
		'tell the user what we are doing
		Repository.WriteOutput "Link to Domain Model", "Adding trace between " &sourceElement.Name & " and " & targetElement.Name, 0
		dim trace as EA.Connector
		set trace = sourceElement.Connectors.AddNew("","trace")
		trace.Alias = "automatic"
		trace.SupplierID = targetElement.ElementID
		trace.Update
	end if
end function
function addToClassDictionary(PackageGUID, dictionary)
	dim package as EA.Package
	set package = Repository.GetPackageByGuid(PackageGUID)
	
	'get the classes in the dictionary (recursively
	addClassesToDictionary package, dictionary
end function
function addClassesToDictionary(package, dictionary)
	dim classElement as EA.Element
	dim subpackage as EA.Package
	'process owned elements
	for each classElement in package.Elements
		if classElement.Type = "Class" AND len(classElement.Name) > 0 AND not dictionary.Exists(classElement.Name) then
			dictionary.Add classElement.Name,  classElement
		end if
	next
	'process subpackages
	for each subpackage in package.Packages
		addClassesToDictionary subpackage, dictionary
	next
end function

'Create a reges pattern like this "\b(name1|name2|name3)\b" based on the 
function createRegexPattern(dictionary)
	Dim patternString
	dim className
	'add begin
	patternString = "\b("
	dim addPipe
	addPipe = FALSE
	for each className in dictionary.Keys
			if addPipe then
				patternString = patternString & "|"
			else
				addPipe = True
			end if
			patternString = patternString & className
	next
	'add end
	patternString = patternString & ")s?\b"
	'return pattern
	createRegexPattern = patternString
end function
'returns an ArrayList of the given package and all its subpackages recursively
function getPackageTree(package)
	dim packageList
	set packageList = CreateObject("System.Collections.ArrayList")
	addPackagesToList package, packageList
	set getPackageTree = packageList
end function
'make an id string out of the package ID of the given packages
function makePackageIDString(packages)
	dim package as EA.Package
	dim idString
	idString = ""
	dim addComma 
	addComma = false
	for each package in packages
		if addComma then
			idString = idString & ","
		else
			addComma = true
		end if
		idString = idString & package.PackageID
	next 
	'if there are no packages then we return "0"
	if packages.Count = 0 then
		idString = "0"
	end if
	'return idString
	makePackageIDString = idString
end function
'returns an ArrayList with the elements accordin tot he ObjectID's in the given query
function getElementsFromQuery(sqlQuery)
	dim elements 
	set elements = Repository.GetElementSet(sqlQuery,2)
	dim result
	set result = CreateObject("System.Collections.ArrayList")
	dim element
	for each element in elements
		result.Add Element
	next
	set getElementsFromQuery = result
end function
'returns a dictionary of all elements in the query with their name as key, and the element as value.
'for elements with the same name only one will be returned
function getElementDictionaryFromQuery(sqlQuery)
	dim elements 
	set elements = Repository.GetElementSet(sqlQuery,2)
	dim result
	set result = CreateObject("Scripting.Dictionary")
	dim element
	for each element in elements
		if not result.Exists(element.Name) then
		result.Add element.Name, element
		end if
	next
	set getElementDictionaryFromQuery = result
end function
'gets the content of the linked document in the given format (TXT, RTF or EA)
function getLinkedDocumentContent(element, format)
	dim linkedDocumentRTF
	dim linkedDocumentEA
	dim linkedDocumentPlainText
	linkedDocumentRTF = element.GetLinkedDocument()
	if format = "RTF" then
		getLinkedDocumentContent = linkedDocumentRTF
	else
		linkedDocumentEA = Repository.GetFieldFromFormat("RTF",linkedDocumentRTF)
		if format = "EA" then
			getLinkedDocumentContent = linkedDocumentEA
		else
			linkedDocumentPlainText = Repository.GetFormatFromField("TXT",linkedDocumentEA)
			getLinkedDocumentContent = linkedDocumentPlainText
		end if
	end if
end function
'let the user select a package
function selectPackage()
	dim documentPackageElementID 		
	documentPackageElementID = Repository.InvokeConstructPicker("IncludedTypes=Package") 
	if documentPackageElementID > 0 then
		dim packageElement as EA.Element
		set packageElement = Repository.GetElementByID(documentPackageElementID)
		dim package as EA.Package
		set package = Repository.GetPackageByGuid(packageElement.ElementGUID)
	else
		set package = nothing
	end if 
	set selectPackage = package
end function
'add the given package and all subPackges to the list (recursively
function addPackagesToList(package, packageList)
	dim subPackage as EA.Package
	'add the package itself
	packageList.Add package
	'add subpackages
	for each subPackage in package.Packages
		addPackagesToList subPackage, packageList
	next
end function