02-12-2014 01:12 PM
I would like to use "Substitute" utility class in order to replace in a diagram IT-Service with an application.
Here is my code:
Sub Main() Dim oDrawingLink As MegaDrawingLink Dim oDrawing As MegaDrawing Dim oITService, oApplication, oMetaAssociationEnd As MegaObject Set root = env.GetRoot 'To retrieve an object implementing the subsitution, used the santard macro : DiagramsObjectsSubstitute. Set oDiagramsObjects = env.GetMacro("DiagramsObjectsSubstitute") ' To retrieve an object implementing the collection expection by the substituer, ' used the standard macro : _MegaRpCollection. ' The object returned type is MegaRpCollection. Set oDiagram = root.GetObjectFromID("~1Br8Za2VKL)E[Nota Integrativa - Flowchart-43]") Set oOperation = root.GetObjectFromID("~0xq8lVZG9v90[Predisporre parte A1 (IT)]") Set oITService = root.GetObjectFromID("~PDz8nYYM8Pk0[Service1]") Set oApplication = root.GetObjectFromID("~3yJGuwNk7fo8[1 MS Excel]") 'Set oMetaAssociationEnd = root.GetObjectFromID("~cqUi4EB5iK03[IT Service]") Set oMetaAssociationEnd = root.GetObjectFromID("~hqUiTCB5iK72[Operation]") Set oDrawing = oDiagram.Drawing("RW") Set megaObjectCollection = env.GetMacro("_MegaRpCollection") 'Test Set oDrawingLink = oDrawing.DrawingLinks(1) arDrawingLink = FindDrawingLink(oDrawing, oITService.GetID(), oOperation.GetID(), oMetaAssociationEnd.GetID()) Set oDrawingLink = arDrawingLink(0) 'MsgBox oDrawingLink.DirectDrawingObject.Name + "<->" + oDrawingLink.OppositeDrawingObject.Name megaObjectCollection.Create "ConvertOperation", root ' Use the functions written below to feed the collection. Call collectionAddLink(megaObjectCollection, oDrawingLink, oDrawingLink) Call collectionAddObject(megaObjectCollection, oITService, oApplication) ' Performs the substitution. oDiagramsObjects.Substitute megaObjectCollection, oDiagram MsgBox "Operation ended" End Sub '-------------------------------------------------------------------- ' This function inserts a pair of item links used during the substitution. ' @param oldLink : the linked obtained using the GetRelactionShip function on a megaobject. ' this link should be present in the diagram. ' @param newLink : the link replacing the old one. Sub collectionAddLink(megaObjectCollection, oldlink, newlink) Set newItem = megaObjectCollection.Add(oldlink.GetRelationship) newItem.Prop("NewMaster") = newlink.GetSource.GetProp("_idabs", "Ascii") newItem.Prop("NewSlave") = newlink.GetTarget.GetProp("_idabs", "Ascii") newItem.Prop("NewMetaAssociationEnd") = root.GetObjectFromID(newlink.GetTypeID).GetProp("_idAbs", "Ascii") End Sub '-------------------------------------------------------------------- ' This function inserts a pair of items used during the substitution. ' @param oldObject : the object replaced in the diagram. ' @param newObject : the object replacing the old one. Sub collectionAddObject(megaObjectCollection, oldObject, newObject) Set newItem = megaObjectCollection.Add(oldObject) newItem.Prop("NewObject") = newObject.GetProp("_idabs", "Ascii") End Sub Function FindDrawingLink(oDrawing, idRpMaster, idRpSlave, idLeg) ReDim arDrawingLink(0) For Each oDrawingLink In oDrawing.DrawingLinks If ((idLeg = oDrawingLink.OppositeLegId _ And idRpSlave = oDrawingLink.OppositeDrawingObject.ID _ And idRpMaster = oDrawingLink.DirectDrawingObject.ID) _ Or (idLeg = oDrawingLink.DirectLegId _ And idRpSlave = oDrawingLink.DirectDrawingObject.ID _ And idRpMaster = oDrawingLink.OppositeDrawingObject.ID)) Then ReDim Preserve arDrawingLink(UBound(arDrawingLink) + 1) Set arDrawingLink(UBound(arDrawingLink) - 1) = oDrawingLink End If Next FindDrawingLink = arDrawingLink End Function
The questions are:
1)At line 43: oldlink.GetRelationship I'm getting the VB 438 error -> "Object doesn't support this property or method". What does it wrong?
2)Can old and the new link be the same. In other words can I use the same link? (line 30)
09-12-2014 08:02 PM
Sorry been busy,
it should be more or less something like below. I could have a look at your script in the coming days though and see if I can work-out something starting from your example
'option explicit
Sub main
dim oRoot
dim colOldObject, colNewObject
dim oOldObject, oNewObject
dim obj
dim colDiagramsWithOldObject, oDiagram, refObj
oRoot = megaDB
'To retrieve an object implementing the subsitution, used the santard
'macro : DiagramsObjectsSubstitute.
Set oDiagramsObjects = MegaEnv.getMacro("DiagramsObjectsSubstitute")
'To retrieve an object implementing the collection expection by the
'substituer,
'used the standard macro : _MegaRpCollection.
'The object returned type is MegaRpCollection.
Set megaObjectCollection = MegaEnv.GetMacro("_MegaRpCollection")
megaObjectCollection.Create "ConvertOperation", GetRoot
'Use the functions written below to feed the collection.
colOldObject = oRoot.getCollection ("<ENTER METACLASS OF OBJECTS TO REPLACE>")
for each oOldObject in colOldObject
'create newObject, possible add check to see if object already exist
set colNewObject= oRoot.getCollection ("<ENTER NEW METACLASS NAME>")
oNewObject = colNewObject.create
collectionAddObject megaObjectCollection, oOldObject, oNewObject
'Substitute links: enter MetaAssociationEnd
'eg moveLink("Owner Packager")
moveLink("<METAASSOCIATIONEND NAME>")
'movelink assumes that the old and new object have the same metaassociationend name towards other object.
' for owner packager this is normally the case, but it's also possible that you need to move the links of one 'metaassociationend towards another one. If that is the case you need to use the function provided by mega and specify 'both metaassociationends, first the old one and then the new one.
'Substitution on diagram old object by new object
'get diagrams linked to oldobject
colDiagramsWithOldObject = oOldObject.getCollection("Diagram")
for each oDiagram in colDiagramsWithOldObject
oDiagram.GetCollection("<NEW OBJECT METACLASS NAME").Add oNewObject
oDiagramsObjects.Substitute megaObjectCollection, oDiagram
next
next
msgbox "END OF SCRIPT"
end sub
'--------------------------------------------------------------------
'This function inserts a pair of items used during the substitution.
'@param oldObject : the object replaced in the diagram.
'@param newObject : the object replacing the old one.
Sub collectionAddObject (megaObjectCollection, oldObject, newObject)
Set newItem = megaObjectCollection.Add (oldObject)
newItem.Prop("NewObject") = newObject.getProp("Absolute Identifier")
'repeat for each attribute to take over
newObject.setProp("<ATTRIBUTE NAME>") = oldObject.getProp("<ATTRIBUTE NAME>")
End Sub
'--------------------------------------------------------------------
'This function moves the links of the old object to the new object
sub moveLink(linkName)
dim object
for each object in oOldObject.getCollection(linkName)
oNewObject.getCollection(linkName).Add(object)
next
end sub
04-12-2014 02:25 PM
how can the old and new link be the same? you are replacing the object with something new, the links should be different.
I have the script for this. I'll have a look tonight and post it