2
« on: March 30, 2026, 05:15:56 pm »
I've had some fun with layouting diagrams, in scripts.
It is basically simple geometry on two axis. You simply have to do the work.
It's not difficult, but a lot of work to get right. And more often then not, a certain layouting algorithm will work only in a specific type of diagram, with a specific type of elements on there.
I think the only way we will successfully solve this, is to include an AI agent that can make human-like decisions.
The hardest part however is not the placement of the elements, but the layout of the connectors. That is a whole different ballgame.
Here's a script with some functions to layout a diagram. It might give you some inspiration.
!INC Local Scripts.EAConstants-VBScript
!INC Wrappers.Include
'
' Script Name: Format BOPF diagram
' Author: Geert Bellekens
' Purpose: Format a diagram containing BOPF elemnets
' Date: 2021-03-05
'
const width = 100
const verticalPadding = 10
const horizontalPadding = 200
dim lsDirectMode, lsAutoRouteMode, lsCustomMode, lsTreeVerticalTree, lsTreeHorizontalTree, _
lsLateralHorizontalTree, lsLateralVerticalTree, lsOrthogonalSquareTree, lsOrthogonalRoundedTree
lsDirectMode = "1"
lsAutoRouteMode = "2"
lsCustomMode = "3"
lsTreeVerticalTree = "V"
lsTreeHorizontalTree = "H"
lsLateralHorizontalTree = "LH"
lsLateralVerticalTree = "LC"
lsOrthogonalSquareTree = "OS"
lsOrthogonalRoundedTree = "OR"
dim defaultStyle
' set here the default style to be used
defaultStyle = lsOrthogonalSquareTree
function formatBOPFDiagram(diagram)
'inform user
Repository.WriteOutput outPutName, now() & " Starting formatting diagram '" & diagram.Name & "'" , 0
'auto layout diagram to get correct sizes
'auto layout diagram
dim diagramGUIDXml
'The project interface needs GUID's in XML format, so we need to convert first.
diagramGUIDXml = Repository.GetProjectInterface().GUIDtoXML(diagram.DiagramGUID)
'Then call the layout operation
Repository.GetProjectInterface().LayoutDiagramEx diagramGUIDXml, lsDiagramDefault, 4, 20 , 20, false
diagram.Update
'reload the diagram to make sure it works in all cases
set diagram = Repository.GetDiagramByID(diagram.DiagramID)
dim diagramObjects
set diagramObjects = getDiagramObjectsDictionary(diagram)
'get the diagramObject for the owner of the diagram
dim diagramObjectOwner as EA.DiagramObject
if diagramObjects.exists(diagram.ParentID) then
set diagramObjectOwner = diagramObjects.Item(diagram.ParentID)
'get diagram object object
dim diagramOwner as EA.Element
set diagramOwner = Repository.GetElementByID(diagram.ParentID)
dim x
dim y
'determine start position based on the owner's stereotype
if diagramOwner.Stereotype = "BOPF_businessObject" then
x = 10 'start top left for business object
else
x = 600 'start in the middle for node
end if
y = -10
dim height
height = abs(diagramObjectOwner.bottom) - abs(diagramObjectOwner.Top)
'set first position
diagramObjectOwner.left = x
diagramObjectOwner.right = x + width
diagramObjectOwner.top = y
diagramObjectOwner.bottom = y - height
diagramObjectOwner.Update
'process sub elements
formatSubElements diagramOwner, diagramObjectOwner, diagram, diagramObjects
'process combined datatype
if diagramOwner.Stereotype = "BOPF_node" then
formatDatatype diagramOwner, diagram, diagramObjects
end if
' Process authorizations. Usually there is only one authorization object per node. For now layout on each other
formatAuthorizationObjects diagram, diagramObjects
end if
'format links
formatLinks diagram
'reload diagram
diagram.Update
Repository.ReloadDiagram diagram.diagramID
'inform user
Repository.WriteOutput outPutName, now() & " Finished formatting diagram '" & diagram.Name & "'" , 0
end function
function formatLinks(diagram)
dim test as EA.DiagramLink
dim diagramLink as EA.DiagramLink
for each diagramLink in diagram.DiagramLinks
'get the connector
dim connector as EA.Connector
set connector = Repository.GetConnectorByID(diagramLink.ConnectorID)
setConnectorStyle diagramLink, connector
if connector.Stereotype = "SAP_association" then
formatAssociationLink(diagramLink)
end if
next
end function
function formatAssociationLink(diagramLink)
'get the order of the diagram link
dim sqlGetOrder
sqlGetOrder = "select con.seq from " & vbNewLine & _
" ( " & vbNewLine & _
" select c2.Connector_ID, ROW_NUMBER() over (order by c2.Name, c2.Connector_ID) as seq " & vbNewLine & _
" from t_connector c " & vbNewLine & _
" inner join t_connector c2 on c2.Start_Object_ID = c.Start_Object_ID " & vbNewLine & _
" and c2.End_Object_ID = c.End_Object_ID " & vbNewLine & _
" and c2.Stereotype = c.Stereotype " & vbNewLine & _
" inner join t_diagramlinks dl on dl.ConnectorID = c2.Connector_ID " & vbNewLine & _
" and dl.DiagramID = " & diagramLink.DiagramID & " " & vbNewLine & _
" where c.Connector_ID = '" & diagramLink.ConnectorID & "' " & vbNewLine & _
" ) con " & vbNewLine & _
" where con.Connector_ID = '" & diagramLink.ConnectorID & "' "
dim results
set results = getArrayListFromQuery(sqlGetOrder)
dim order
order = results(0)(0)
if order <> "1" then
'get key value pairs for geometry
dim geometryKeyValues
set geometryKeyValues = getKeyValuePairs(diagramLink.Geometry)
'move ey and ex
dim ey
ey = cInt(geometryKeyValues("EY"))
ey = ey - cint(order) * 20 'move end down
geometryKeyValues("EY") = ey
dim ex
ex = cInt(geometryKeyValues("EX"))
ex = ex - cint(order) * 20 'move end left
geometryKeyValues("EX") = ey
'then join again
diagramLink.Geometry = joinKeyValuePairs(geometryKeyValues)
'and update
diagramLink.Update
end if
end function
'actually sets the connector style
function setConnectorStyle(diagramLink, connector)
if diagramLink is nothing then
exit function
end if
'split the style into its parts
dim styleparts
dim styleString
' Throw away the last ; so that an empty cell at the end is not created when its Split
if len(diagramLink.Style) > 0 then
styleString = Left(diagramLink.Style, Len(diagramLink.Style)-1)
else
styleString = ""
end if
styleparts = Split(styleString,";")
dim mode
dim tree
dim linestyle
mode = ""
tree = ""
linestyle = determineLineStyle(connector)
'get out if no linestyle found
if len(linestyle) = 0 then
setConnectorStyle = false
exit function
end if
'these connectorstyles use mode=3 and the tree
if linestyle = lsTreeVerticalTree or _
linestyle = lsTreeHorizontalTree or _
linestyle = lsLateralHorizontalTree or _
linestyle = lsLateralVerticalTree or _
linestyle = lsOrthogonalSquareTree or _
linestyle = lsOrthogonalRoundedTree then
mode = "3"
tree = linestyle
else
mode = linestyle
end if
'set the mode value
setStylePart styleparts, "Mode", mode
'set the tree value
setStylePart styleparts, "TREE", tree
' setStylePart styleparts, "Color", determineColor(connector)
' setStylePart styleparts, "LWidth", determineLineWidth(connector)
' update style (add in trailing ; that is needed)
diagramLink.Style = join(styleparts, ";") & ";"
'clear path and geometry
diagramLink.Geometry = ""
diagramLink.Path = ""
'save diagramLink
diagramLink.update
'return true for dirty
setConnectorStyle = true
end function
function determineLineStyle(connector)
determineLineStyle = "" 'default none
'only do non stereotyped relations
if connector.Stereotype = "SAP_composition" then
determineLineStyle = lsLateralHorizontalTree
elseif connector.Stereotype = "BOPF_authorizationCheck" then
determineLineStyle = lsOrthogonalSquareTree
else
determineLineStyle = lsDirectMode
end if
end function
' Set the style to the specified value
function setStylePart(styleparts, style, value)
dim i
dim stylePart
dim index
index = -1
for i = 0 to Ubound(styleparts)
stylePart = styleparts(i)
if Instr(stylepart, style & "=") > 0 then
index = i
end if
next
If Len(value) > 0 then
' Adding to style
if index = -1 then
' extend the array when style is not already in array
redim preserve styleparts(Ubound(styleparts) + 1)
index = Ubound(styleparts)
end if
styleparts(index) = style & "=" & value
else
' Removing style from styleparts
if index >= 0 then
' copy the last value over the top of index, and then shrink the array
styleparts(index) = styleparts(Ubound(styleparts))
redim preserve styleparts(Ubound(styleparts) - 1)
end if
' if the index was -1 it already did not exist in the styleparts
end if
end function
function formatSubElements(diagramOwner, diagramObject, diagram, diagramObjects)
dim symmetric
if diagramOwner.Stereotype = "BOPF_node" then
symmetric = true
else
symmetric = false
end if
'get list of ID's that are owned by this diagramObject, and that are part of the diagram
dim diagramElementIDs
diagramElementIDs = Join(diagramObjects.Keys, ",")
dim sqlGetData
sqlGetData = "select o.Object_ID " & vbNewLine & _
" from (select o.Object_ID, o.Name, o.stereotype, " & vbNewLine & _
" case when o.stereotype = 'BOPF_determination' then 1 " & vbNewLine & _
" when o.stereotype = 'BOPF_validation' then 2 " & vbNewLine & _
" when o.stereotype = 'BOPF_action' then 3 " & vbNewLine & _
" else 99 end as seqOrder " & vbNewLine & _
" from t_object o " & vbNewLine & _
" where o.ParentID = " & diagramObject.ElementID & " " & vbNewLine & _
" and o.Object_ID in (" & diagramElementIDs & ") " & vbNewLine & _
" ) o " & vbNewLine & _
" order by o.seqOrder, o.stereotype, o.name "
dim subElementIDs
set subElementIDs = getVerticalArrayListFromQuery(sqlGetData)
dim subElementID
dim x
dim y
y = diagramObject.bottom
dim height
if subElementIDs.Count > 0 then
dim subDiagramObject as EA.DiagramObject
'determine max width
dim maxWidth
maxWidth = 0
for each subElementID in subElementIDs(0)
set subDiagramObject = diagramObjects(CLng(subElementID))
dim elementWidth
elementWidth = subDiagramObject.right - subDiagramObject.left
if elementWidth > maxWidth then
maxWidth = elementWidth
end if
next
if symmetric then
'format elements
dim position
position = 0 '0 = left, 1 = right, 2 = far left, 3 = far right
dim xValues
set xValues = CreateObject("System.Collections.ArrayList")
dim center
center = (diagramObject.left + diagramObject.right) /2
dim minBottom
minBottom = diagramObject.Bottom - (verticalPadding * 3)
'format elements
xValues.Add(center - horizontalPadding) '0
xValues.Add(center + horizontalPadding) '1
xValues.Add(center - (horizontalPadding * 2))'2
xValues.Add(center + (horizontalPadding * 2))'3
y = diagramObject.bottom - verticalPadding
for each subElementID in subElementIDs(0)
'go down on the first and and 3th position
if position = 0 or position = 2 then
y = minBottom - verticalPadding
end if
x = xValues(position)
set subDiagramObject = diagramObjects(CLng(subElementID))
height = abs(subDiagramObject.bottom) - abs(subDiagramObject.Top)
if position = 0 or position = 2 then
subDiagramObject.left = x
subDiagramObject.right = x + maxWidth
else
subDiagramObject.right = x
subDiagramObject.left = x - maxWidth
end if
subDiagramObject.top = y
subDiagramObject.bottom = y - height
subDiagramObject.update
if subDiagramObject.bottom < minBottom then
minBottom = subDiagramObject.bottom
end if
'reset position after 3
if position = 3 then
position = 0
else
position = position + 1
end if
next
else
'format elements
x = diagramObject.right + (horizontalPadding /2)
for each subElementID in subElementIDs(0)
set subDiagramObject = diagramObjects(CLng(subElementID))
height = abs(subDiagramObject.bottom) - abs(subDiagramObject.Top)
y = y - verticalPadding 'go down
subDiagramObject.left = x
subDiagramObject.right = x + maxWidth
subDiagramObject.top = y
subDiagramObject.bottom = y - height
subDiagramObject.update
y = subDiagramObject.bottom
'go one level deeper
y = formatSubElements(diagramOwner, subDiagramObject, diagram, diagramObjects)
next
end if
end if
'return Y
formatSubElements = y
end function
function formatDatatype(diagramOwner,diagram, diagramObjects)
'get list of ID's that are owned by this diagramObject, and that are part of the diagram
dim diagramElementIDs
diagramElementIDs = Join(diagramObjects.Keys, ",")
dim sqlGetData
sqlGetData = "select o.Object_ID " & vbNewLine & _
" from t_object o " & vbNewLine & _
" where o.Object_Type = 'Datatype' " & vbNewLine & _
" and o.Object_ID in (" & diagramElementIDs & ") "
dim datatypeIDs
set datatypeIDs = getVerticalArrayListFromQuery(sqlGetData)
dim datatypeID
dim x
x = 1200
dim y
y = -20
if datatypeIDs.Count > 0 then
for each datatypeID in datatypeIDs(0)
dim diagramObject as EA.DiagramObject
set diagramObject = diagramObjects(CLng(datatypeID))
dim height
height = abs(diagramObject.bottom) - abs(diagramObject.Top)
dim width
width = diagramObject.right - diagramObject.left
diagramObject.left = x
diagramObject.right = x + width
diagramObject.top = y
diagramObject.bottom = y - height
diagramObject.Update
next
end if
end function
''debug
'sub test
' dim diagram as EA.Diagram
' set diagram = Repository.GetDiagramByGuid("{50315683-1BB7-4557-B6A3-06FAFB9A6E23}")
' formatBOPFDiagram(diagram)
'end sub
'test
'formatAuthorizationObjects
function formatAuthorizationObjects (diagram, diagramObjects)
'1. Find all authorisation objects on the diagrams
'get list of ID's that are owned by this diagramObject, and that are part of the diagram
dim diagramElementIDs
diagramElementIDs = Join(diagramObjects.Keys, ",")
dim sqlGetData
sqlGetData= "select o.Object_ID " & vbNewLine & _
" from t_object o " & vbNewLine & _
" where o.Stereotype = 'SAP_authorizationObject' " & vbNewLine & _
" and o.Object_ID in (" & diagramElementIDs & ") "
dim authorizationObjectIDs
set authorizationObjectIDs = getVerticalArrayListFromQuery(sqlGetData)
'2. Find the BO node connected to the authorization object
dim authorizationObjectID
if authorizationObjectIDs.Count > 0 then
for each authorizationObjectID in authorizationObjectIDs(0)
dim diagramObject as EA.DiagramObject
set diagramObject = diagramObjects(CLng(authorizationObjectID))
'Find BO node
'Find BO node id
sqlGetData= "select o.Object_ID " & vbNewLine & _
" from t_object o " & vbNewLine & _
" inner join t_connector c " & vbNewLine & _
" on c.Start_Object_ID = o.Object_ID " & vbNewLine & _
" where o.Stereotype = 'BOPF_node' " & vbNewLine & _
" and o.Object_ID in (" & diagramElementIDs & ") " & vbNewLine & _
" and c.End_Object_ID = "& authorizationObjectID
dim BONodeIDs
set BONodeIDs = getVerticalArrayListFromQuery(sqlGetData)
if BONodeIDs.Count > 0 then
dim BONodeID
for each BONodeID in BONodeIDs(0)
dim diagramObjectBONode as EA.DiagramObject
set diagramObjectBONode = diagramObjects(CLng(BONodeID))
dim height
height = abs(diagramObject.bottom) - abs(diagramObject.Top)
dim width
width = diagramObject.right - diagramObject.left
dim x
x = diagramObjectBONode.right + 300
dim y
y = diagramObjectBONode.top
'3. Set the top coordinate of the authorization object equal to the ones of the bo node but more to the right.
diagramObject.left = x
diagramObject.right = x + width
diagramObject.top = y
diagramObject.bottom = y - height
diagramObject.Update
exit for
next
end if
next
end if
end function
Geert
Show Posts
