4
« on: December 23, 2016, 08:51:39 am »
BTW anyone that read this interested in the solution. Probably not most efficient way but it works. Not sure if this is even a super useful functionality, but I was unsure how to filter well within the section of document editor so this makes it easy to filter by tagged values. (EDIT: just realized it'll tell you that the tags are reset even if you cancel, but it won't do anything if you do cancel)
option explicit
!INC Local Scripts.EAConstants-VBScript
'
' Script Name:
' Author:
' Purpose: At tags to elements located inside swimlanes with name "Actor" and value of the swimlane name (and remove "Actor" tags from elements not located in a swimlane)
' Date:
'
'
sub OnDiagramScript()
'GET DIAGRAM REFERENCE
dim currentDiagram as EA.Diagram
set currentDiagram = Repository.GetCurrentDiagram()
if not currentDiagram is nothing then
' Get a reference to any selected connector/objects
dim selectedConnector as EA.Connector
dim selectedObjects as EA.Collection
set selectedConnector = currentDiagram.SelectedConnector
set selectedObjects = currentDiagram.SelectedObjects
if not selectedConnector is nothing then
' A connector is selected
elseif selectedObjects.Count > 0 then
' One or more diagram objects are selected
else
' Nothing is selected
end if
else
Session.Prompt "This script requires a diagram to be visible", promptOK
end if
'ADD THE ACTOR TAGS BY SWIM LANE
'ask user
dim result : dim clearTags
result = MsgBox("This script will reset and add 'Actor' tags for all diagram objects. Do you wish to proceed?", vbYesNo + vbQuestion, "Reset Actor Tags")
Select Case result
Case vbYes
MsgBox "Script initiated..."
clearTags = true
Case vbNo
MsgBox "The script has been terminated by user.",vbinformation,"Script cancelled"
clearTags = false
End Select
'clear and reset actor tags
if clearTags then
'get a list of the lanes in diagram
dim arrListLanes
set arrListLanes = CreateObject("System.Collections.ArrayList")
set arrListLanes = getDiagramObjects(currentDiagram, "Lane")
'tag elements by lane
tagActors currentDiagram, arrListLanes
end if
msgbox "Actor tags have been reset.", vbinformation, "Script complete"
end sub
'removes actor tags then re-tags
function tagActors(currentDiagram, arrListLanes)
dim poolArrList, i, poolCount, laneCount, tagUpdated
dim tempElement as EA.Element
dim parentElement as EA.Element
dim laneElement as EA.Element
dim tag as EA.TaggedValue
dim diagramObject as EA.DiagramObject
poolCount = 0 : laneCount = 0 : tagUpdated = false
'clear any existing actor tags from diagram objects
for each diagramObject in currentDiagram.DiagramObjects
set tempElement = getElementByID(diagramObject.ElementID)
dim tags as EA.Collection
set tags = tempElement.TaggedValues
for i = tags.Count - 1 to 0 step -1
dim theTag as EA.TaggedValue
set theTag = tags.GetAt(i)
if theTag.Name = "Actor" then
call tempElement.TaggedValues.DeleteAt(i, FALSE)
end if
next
next
'tag the desired elements
for each diagramObject in currentDiagram.DiagramObjects
set tempElement = getElementByID(diagramObject.ElementID)
for i = 0 to arrListLanes.count-1
dim laneID : laneID = arrListLanes(i).ElementID
if tempElement.ParentID = laneID then
set parentElement = getElementByID(tempElement.ParentID)
if parentElement.Stereotype = "Lane" then
for each tag in tempElement.TaggedValues
if tag.Name = "Actor" and tag.Value <> parentElement.Name then
tag.Value = parentElement.Name
tag.Update
parentElement.TaggedValues.Refresh
tagUpdated = true
end if
next
if not tagUpdated then
set tag = tempElement.TaggedValues.AddNew("Actor","")
tag.Value = parentElement.Name
tag.Update
parentElement.TaggedValues.Refresh
end if
end if
end if
next
next
end function
'returns array list of diagram objects of specified stereotype
function getDiagramObjects(diagram, elementStereoType)
dim selectedObjectsList
set selectedObjectsList = CreateObject("System.Collections.ArrayList")
dim diagramObject as EA.DiagramObject
dim diagramConnector as EA.Connector
dim element as EA.Element
for each diagramObject in diagram.DiagramObjects
set element = Repository.GetElementByID(diagramObject.ElementID)
if element.StereoType = elementStereoType then
selectedObjectsList.Add diagramObject 'why don't I just add the element instead of the object..?
end if
next
'return selected Elements
set getDiagramObjects = selectedObjectsList
end function 'end getDiagramObjects
OnDiagramScript
Show Posts
