option explicit
!INC Local Scripts.EAConstants-VBScript
sub main
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"
linkSelectionToDomainModel(domainModelPackage)
Repository.WriteOutput "Link to Domain Model", "Finished!", 0
end if
end if
end sub
main
function linkSelectionToDomainModel(domainModelPackage)
dim dictionary
Set dictionary = CreateObject("Scripting.Dictionary")
Repository.WriteOutput "Link to Domain Model", "Creating domain model dictionary", 0
addToClassDictionary domainModelPackage.PackageGUID, dictionary
Repository.WriteOutput "Link to Domain Model", "Interpreting dictionary", 0
dim pattern
pattern = createRegexPattern(dictionary)
Dim regExp
Set regExp = CreateObject("VBScript.RegExp")
regExp.Global = True
regExp.IgnoreCase = False
regExp.Pattern = pattern
dim treeSelectedType
treeSelectedType = Repository.GetTreeSelectedItemType()
select case treeSelectedType
case otElement
dim selectedElements as EA.Collection
set selectedElements = Repository.GetTreeSelectedElements()
linkDomainClassesWithElements dictionary,regExp,selectedElements
case otPackage
dim selectedPackage as EA.Package
set selectedpackage = Repository.GetTreeSelectedObject()
linkDomainClassesWithElementsInPackage dictionary, regExp,selectedPackage
case else
Session.Prompt "You have to select Elements or a Package", promptOK
end select
end function
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
for each element in elements
Repository.WriteOutput "Link to Domain Model", "Linking element: " & element.Name, 0
removeAllAutomaticTraces element
dim elementText
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)
linkMatchesWithelement matches, element, dictionary
dim scenario as EA.Scenario
dim dependencies
set dependencies = getDependencies(element)
for each scenario in element.Scenarios
dim scenarioStep as EA.ScenarioStep
for each scenarioStep in scenario.Steps
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
linkElementsWithAutomaticTrace element, classToMatch
next
scenarioStep.Update
scenario.Update
next
next
next
end function
function linkMatchesWithelement(matches, element, dictionary)
dim classesToMatch
Set classesToMatch = getClassesToMatchDictionary(matches,dictionary)
dim classToMatch as EA.Element
for each classToMatch in classesToMatch.Items
linkElementsWithAutomaticTrace element, classToMatch
next
end function
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
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
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")
For each match in matches
if not allClassesDictionary.Exists(match.Value) then
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
function linkElementsWithAutomaticTrace(sourceElement, targetElement)
dim linkExists
linkExists = false
dim existingConnector as EA.Connector
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
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)
addClassesToDictionary package, dictionary
end function
function addClassesToDictionary(package, dictionary)
dim classElement as EA.Element
dim subpackage as EA.Package
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
for each subpackage in package.Packages
addClassesToDictionary subpackage, dictionary
next
end function
function createRegexPattern(dictionary)
Dim patternString
dim className
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
patternString = patternString & ")s?\b"
createRegexPattern = patternString
end function
function getPackageTree(package)
dim packageList
set packageList = CreateObject("System.Collections.ArrayList")
addPackagesToList package, packageList
set getPackageTree = packageList
end function
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 packages.Count = 0 then
idString = "0"
end if
makePackageIDString = idString
end function
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
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
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
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
function addPackagesToList(package, packageList)
dim subPackage as EA.Package
packageList.Add package
for each subPackage in package.Packages
addPackagesToList subPackage, packageList
next
end function
One of the scripts in the initial set is the scriptLoadScripts in the group Script Management. If you execute this script you can choose the library folder from the library downloaded from GitHub.
.
