cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

"Substitute" utility class issue

agiovannetti
Super Contributor

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)

2 Replies

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
  

SVanSchoonlandt
Honored Contributor

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