7
« on: November 09, 2019, 05:36:42 pm »
Thanks Geert,
The code creates a collection of elements and child elements on the object that was used as context. Tagged values are also required on the child elements. A composition connector, in addition to nesting is also required.
Capability
Current State Assessment
Tech Assessment
Process Assessment
etc.
Target State
Tech Assessment
Process Assessment
etc.
sub OnProjectBrowserScript()
' Get the type of element selected in the Project Browser
dim treeSelectedType
treeSelectedType = Repository.GetTreeSelectedItemType()
select case treeSelectedType
case otElement
' Code for when an element is selected
dim theCapability as EA.Element
set theCapability = Repository.GetTreeSelectedObject()
dim AssessmentName
If theCapability.Stereotype = "ArchiMate_Capability" then
AssessmentName = InputBox( "Entrez un nom pour la nouvelle évaluation.", "Create Assessment", "évaluation année 9999")
Call CreateAssessmentStructure(theCapability, AssessmentName)
else
Session.Prompt "Sélectionnez un élément de capacité pour exécuter ce script.", promptOK
end if
case else
' Error message
Session.Prompt "Sélectionnez un élément de capacité pour exécuter ce script.", promptOK
end select
end sub
' Creates an assessment structure
Sub CreateAssessmentStructure(capabilityElement, AssessmentName)
Dim CapabilityElements as EA.Collection
Dim newAssessment as EA.Element
Dim NewAssessmentElements as EA.Collection
Dim tecAssessment as EA.Element
Dim infAssessment as EA.Element
Dim prcAssessment as EA.Element
Dim savAssessment as EA.Element
Dim orgAssessment as EA.Element
Dim matAssessment as EA.Element
set CapabilityElements = capabilityElement.Elements
set newAssessment = CapabilityElements.AddNew(AssessmentName,"Class")
newAssessment.Stereotype = "Archimate3::ArchiMate_Assessment"
newAssessment.Update
' Add composition Relationship to the parent element
Call AddArchimateComposition(capabilityElement,newAssessment)
Set NewAssessmentElements = newAssessment.Elements
Set tecAssessment = NewAssessmentElements.AddNew("TEC","Class")
Set infAssessment = NewAssessmentElements.AddNew("INF","Class")
Set prcAssessment = NewAssessmentElements.AddNew("PRC","Class")
Set savAssessment = NewAssessmentElements.AddNew("SAV","Class")
Set orgAssessment = NewAssessmentElements.AddNew("ORG","Class")
Set matAssessment = NewAssessmentElements.AddNew("MAT","Class")
tecAssessment.Stereotype = "Archimate3::ArchiMate_Assessment"
infAssessment.Stereotype = "Archimate3::ArchiMate_Assessment"
prcAssessment.Stereotype = "Archimate3::ArchiMate_Assessment"
savAssessment.Stereotype = "Archimate3::ArchiMate_Assessment"
orgAssessment.Stereotype = "Archimate3::ArchiMate_Assessment"
matAssessment.Stereotype = "Archimate3::ArchiMate_Assessment"
tecAssessment.Update
infAssessment.Update
prcAssessment.Update
savAssessment.Update
orgAssessment.Update
matAssessment.Update
Call AddTag(newAssessment,"Capability Assessment")
Call AddTag(tecAssessment,"Capability Assessment")
Call AddTag(infAssessment,"Capability Assessment")
Call AddTag(prcAssessment,"Capability Assessment")
Call AddTag(savAssessment,"Capability Assessment")
Call AddTag(orgAssessment,"Capability Assessment")
Call AddTag(matAssessment,"Capability Assessment")
Call AddArchimateComposition(newAssessment,tecAssessment)
Call AddArchimateComposition(newAssessment,infAssessment)
Call AddArchimateComposition(newAssessment,prcAssessment)
Call AddArchimateComposition(newAssessment,savAssessment)
Call AddArchimateComposition(newAssessment,orgAssessment)
Call AddArchimateComposition(newAssessment,matAssessment)
End Sub
' Adds a relationship of a specific type and stereotype
Sub AddArchimateComposition( Source, Target )
dim Conn as EA.Connector
dim ClientEnd as EA.ConnectorEnd
' ClientID = source end, SupplierID = target end
' source end is already set based on the element that owns the Connectors collection. Only need to set SupplierID.
set conn = Source.Connectors.AddNew("", "Association")
Conn.StereoType = "Archimate3::ArchiMate_Composition"
Conn.SupplierID = target.ElementID
Conn.Update
' Establish the aggregation on the client End as Composite
set ClientEnd = Conn.ClientEnd
ClientEnd.Aggregation = 2
ClientEnd.Update
Source.Connectors.Refresh
Target.Connectors.Refresh
end sub
' Adds a tagged value to an element
sub AddTag(theElement, TagName)
Dim ElementTags as EA.Collection
Dim newTag as EA.TaggedValue
set ElementTags = theElement.TaggedValues
set newTag = ElementTags.AddNew(TagName,"")
newTag.Update
end sub
OnProjectBrowserScript