No, not really.
I guess you are trying to solve the problem that people are creating duplicates of existing library elements, which have to be merged later.
What we did to tackle that is to write a little EA-Matic script that checks the names of certain types of elements. (e.g. BPMN Business Process) for which we don't want to allow multiple elements with the same name in the model.
If someone creates such an duplicate element, our script renames it automatically and informs the user.
'[path=\Projects\EA-Matic Scripts]
'[group=EA-Matic]
option explicit
!INC Utils.Util
'
' Script Name: PreventDuplicates
' Author: Geert Bellekens
' Purpose: Prevents duplicate elements based on a list of element types and stereotypes
' Date: 2020-10-10
'
'EA-Matic
Const combinationsToCheck = "UseCase,null;Activity,BusinessProcess;Activity,Activity"
function EA_OnPostNewElement(Info)
'get the elementID from Info
dim elementID
elementID = Info.Get("ElementID")
dim element as EA.Element
set element = Repository.GetElementByID(elementID)
dim renamed
renamed = renameElement(element)
'return true
EA_OnPostNewElement = true
end function
function renameDuplicate(element)
'only if needed
if not elementNeedsChecking(element) then
exit function
end if
'default false
renameDuplicate = false
dim dup
dup = hasDuplicateElements(element)
if dup then
MsgBox "An element with this the same name and stereotype already exists!", vbOKOnly + vbExclamation, "Duplicate Element detected"
renameDuplicate = renameElement(element)
end if
end function
function renameElement(element)
'only if needed
if not elementNeedsChecking(element) then
exit function
end if
dim nextItemID
nextItemID = getNextItemID(element)
if len(nextItemID) > 0 then
dim originalItemID
originalItemID = getItemID(element.Name)
if len(originalItemID) > 0 _
and originalItemID <> element.Name then
element.Name = replace(element.Name, originalItemID, nextItemID)
else
element.Name = nextItemID & " - " & element.Name
end if
else
element.Name = element.ElementID & "_" & element.Name
end if
element.update
'return true
renameElement = true
end function
function elementNeedsChecking(element)
elementNeedsChecking = false
dim combos
combos = Split(combinationsToCheck, ";" )
dim combo
for each combo in combos
dim typeStereo
typeStereo = Split(combo, ",")
dim elementType
elementType = typeStereo(0)
'check type
if lcase(element.Type) = lcase(elementType) _
or lcase(elementType) = "null" then
'check stereotype
dim stereo
stereo = typeStereo(1)
if lcase(element.Stereotype) = lcase(stereo) _
or lcase(stereo) = "null" then
'Found one that needs checking
'BPMN Activities only need checking if they are in the library. We know this because they don't have a parent element
if lcase(element.Stereotype) = "activity" and element.ParentID > 0 then
elementNeedsChecking = false
else
elementNeedsChecking = true
end if
exit function
end if
end if
next
end function
function hasDuplicateElements(element)
dim itemID
itemID = getItemID(element.name)
dim sqlGetData
sqlGetData = "select 'true' as test where exists ( " & vbNewLine & _
"select o.Object_ID from t_object o " & vbNewLine & _
" where o.Name like '" & itemID & "%' " & vbNewLine & _
" and o.Object_Type = '" & element.Type & "' " & vbNewLine & _
" and o.Object_ID <> " & element.ElementID & " "
if len(element.Stereotype) > 0 then
sqlGetData = sqlGetData & vbNewLine & _
" and o.Stereotype = '" & element.Stereotype & "' "
end if
sqlGetData = sqlGetData & ")"
dim duplicates
set duplicates = getArrayListFromQuery(sqlGetData)
'return boolean
if duplicates.Count > 0 then
hasDuplicateElements = true
else
hasDuplicateElements = false
end if
end function
function getItemID(name)
dim assetName
'reset assetName
assetName = ""
dim regExp
Set regExp = CreateObject("VBScript.RegExp")
regExp.Pattern = "^\w+\b\s*-\s*\w+\b\s*-\s*[\w.]+(?:\b\s*-\s*[\w.]*\b)?(?=\s*-\s\w*)"
'try first pattern
dim matches
set matches = regExp.Execute(name)
if matches.Count = 1 then
assetName = matches(0)
end if
if len(assetName) = 0 then
'try second pattern
regExp.Pattern = "^\w+\b\s*-\s*\w+\b\s*-\s*[0-9]+(?=[\s|-])(?!\b\s*-\s)"
set matches = regExp.Execute(name)
if matches.Count = 1 then
assetName = matches(0)
end if
end if
if len(assetName) = 0 then
'try third pattern
regExp.Pattern = "^\w+\b\s*-\s*[0-9]+(?=[\s|-])"
set matches = regExp.Execute(name)
if matches.Count = 1 then
assetName = matches(0)
end if
end if
if len(assetName) = 0 then
assetName = name
end if
'return
getItemID = assetName
end function
function getNextItemID(element)
dim nextItemID
nextItemID = ""
'find closest existing use case in element package
dim closestElement as EA.Element
set closestElement = findClosestElement(element, element.PackageID, 2)
if not closestElement is nothing then
dim itemID
itemID = getItemID(closestElement.Name)
'find last itemID
dim lastItemID
lastItemID = findLastItemID (itemID, element.Type, element.Stereotype)
'get sequence number
dim seqNr
seqNr = right(lastItemID, 3)
if isNumeric(seqNr) then
seqNr = Cint(seqNr)
'increase by one
seqNr = seqNr + 1
nextItemID = left(lastItemID, len(lastItemID) - 3) & right ("00" & seqNr,3)
end if
end if
'return
getNextItemID = nextItemID
end function
function findLastItemID (itemID, elementType, stereotype)
dim lastItemID
lastItemID = ""
dim namePattern
namePattern = left(itemID, len(itemID) - 3)
dim sqlGetData
sqlGetData = "select top(1) o.name from t_object o " & vbNewLine & _
" where o.Object_Type = '" & elementType & "' " & vbNewLine & _
" and isnull(o.Stereotype, '') = '" & stereotype & "' " & vbNewLine & _
" and o.name like '" & namePattern & "[0-9][0-9][0-9]%' " & vbNewLine & _
" order by o.Name desc "
dim results
set results = getVerticalArrayListFromQuery(sqlGetData)
if results.Count > 0 then
dim names
set names = results(0)
if names.Count > 0 then
lastItemID = getItemID(names(0))
end if
end if
'return
findLastItemID = lastItemID
end function
function findClosestElement(element, packageID, searchLevels)
dim closestElement as EA.Element
set closestElement = nothing
'get parent package
dim package as EA.Package
set package = Repository.GetPackageByID(packageID)
'get packageTreeIDString
dim packageTreeIDString
packageTreeIDString = getPackageTreeIDString(package)
'find it in current package
dim sqlGetData
sqlGetData = "select top(1) o.Object_ID from t_object o " & vbNewLine & _
" where o.Object_Type = '" & element.Type & "' " & vbNewLine & _
" and isnull(o.Stereotype, '') = '" & element.Stereotype & "' " & vbNewLine & _
" and o.Package_ID in (" & packageTreeIDString & ") " & vbNewLine & _
" and o.Object_ID <> " & element.ElementID & " " & vbNewLine & _
" and o.name like '% - [0-9][0-9][0-9] - %' " & vbNewLine & _
" order by o.Name desc "
dim elements
set elements = getElementsFromQuery(sqlGetData)
if elements.Count > 0 then
set closestElement = elements(0)
else
' go one level up
if searchLevels > 1 then
set closestElement = findClosestElement(element, package.ParentID, searchLevels -1)
end if
end if
'return
set findClosestElement = closestElement
end function
Dim contextName
Dim contextStereo
Dim contextGUID
function EA_OnContextItemChanged(GUID, ot)
if ot = otElement then
Dim contextElement
set contextElement = Repository.GetElementByGuid(GUID)
if not contextElement is nothing then
contextName = contextElement.Name
contextStereo = contextElement.Stereotype
contextGUID = contextElement.ElementGUID
end if
end if
end function
function EA_OnNotifyContextItemModified(GUID, ot)
'check if the name has been changed
if GUID = contextGUID then
Dim contextElement
set contextElement = Repository.GetElementByGuid(GUID)
'only check if the element has been renamed
if contextName <> contextElement.Name _
or contextStereo <> contextElement.Stereotype then
renameDuplicate(contextElement)
end if
end if
end function
'function test
' dim element as EA.Element
' set element = Repository.GetElementByGuid("{1409A59D-DC65-4c72-A1B1-29FF31CDD88F}")
' element.Update
' renameElement(element)
'end function
'test
Geert
