'-------------------------------------------------------------------------------- 
' 
' Associations to Attributes v1.2 (Rose/C++ only) 
' 
' This script reads classes from a text file nominated by the user. For each class 
' read from the file, call it theAttributeClass, the script converts any associations 
' from classes in the current model to theAttributeClass, navigable to 
' theAttributeClass, into attributes. 
' 
' The Name of the attribute will be the role of theAttributeClass 
' in the original relationship. Since this script is intended to be applied to 
' reverse engineered models it is assumed that there will always be a role name 
' in place. 
' 
' Where multiplicity is 1, the type of the attribute will be theAttributeClass. 
' 
' Where the multiplicity is "*", the attribute type will be the theAttributeClass 
' concatenated with the value of the ContainerClass property (minus its preceding 
' $targetClass). 
' 
' Where the multiplicity is "0..1", the attribute type will be theAttributeClass 
' concatenated with "*". In this case, the contents of the role initial value 
' property (which may be (NULL)) is copied to the attribute InitValue property. 
' 
' Class names are case sensitive. 
' 
' Association Documentation is copied to the Attribute Documentation. 
' 
' The following code generation properties are copied across: 
' DataMemberVisiblity 
' GenerateSetOperation 
' GetSetKinds 
' GetIsConst 
' GetSetByReference 
' GenerateGetOperation is not copied across because the default is TRUE. If there is no 
' Get operation present in the code, the analyzer leaves the property unchanged. 
' 
'  Created by David Hanslip  October 1997. Modified to cater for multiplicities 
' other than 1 in June 1998. 
'-------------------------------------------------------------------------------- 
Type enumProp 
 ordinalValue As Integer 
 enumValue As String 
End Type 

Function ClassExists (ClassName As String ) As Boolean 

 Dim theClass As Class 
 Dim allClasses As ClassCollection 

 Set allClasses = RoseApp.CurrentModel.GetAllClasses () 

 ClassExists = False 
 For ClsID = 1 To AllClasses.Count 
  If AllClasses.GetAt ( ClsID ).Name = ClassName Then 
   ClassExists = True 
  End If 
 Next ClsID 

End Function 

Sub TranscribeProperties (theRole As Role, theAttribute As Attribute) 

 ' DataMemberVisibility 
 ' Copy across property values with the exceptiono of AtRelationshipVisibility 
 ' which should be replaced with AtAttributeVisibility 

 Dim IsOverridden As Boolean 

 'Print theAttribute.GetPropertyValue("cg","DataMemberVisibility") 
 'Print theRole.GetPropertyValue("cg","DataMemberVisibility") 
 If theAttribute.GetPropertyValue("cg","DataMemberVisibility") <> _ 
   theRole.GetPropertyValue("cg","DataMemberVisibility") Then 
   If theRole.GetPropertyValue("cg","DataMemberVisibility") = _ 
    "AtRelationshipVisibility" Then 
    IsOverridden = theAttribute.OverrideProperty("cg", _ 
     "DataMemberVisibility","AtAttributeVisibility") 
  Else 
   IsOverridden = theAttribute.OverrideProperty ("cg", _ 
    "DataMemberVisibility", _ 
     theRole.GetPropertyValue("cg","DataMemberVisibility")) 
  End If 
 End If 

 ' GenerateSetOperation 
 If theAttribute.GetPropertyValue("cg", "GenerateSetOperation") <> _ 
   theRole.GetPropertyValue("cg", "GenerateSetOperation") Then 
  IsOverridden = theAttribute.OverrideProperty ("cg", _ 
   "GenerateSetOperation", theRole.GetPropertyValue("cg","GenerateSetOperation")) 
 End If 

 ' GetSetKinds 
 If theAttribute.GetPropertyValue("cg", "GetSetKinds") <> _ 
   theRole.GetPropertyValue("cg", "GetSetKinds") Then 
  IsOverridden = theAttribute.OverrideProperty ("cg", _ 
   "GetSetKinds", theRole.GetPropertyValue("cg","GetSetKinds")) 
 End If 

 ' GetIsConst 
 If theAttribute.GetPropertyValue("cg", "GetIsConst") <> _ 
  theRole.GetPropertyValue("cg", "GetIsConst") Then 
  IsOverridden = theAttribute.OverrideProperty ("cg", _ 
   "GetIsConst", theRole.GetPropertyValue("cg","GetIsConst")) 
 End If 

 ' GetSetByReference 
 If theAttribute.GetPropertyValue("cg", "GetSetByReference") <> _ 
   theRole.GetPropertyValue("cg", "GetSetByReference") Then 
  IsOverridden = theAttribute.OverrideProperty ("cg", _ 
   "GetSetByReference", theRole.GetPropertyValue("cg","GetSetByReference")) 
 End If 

End Sub 

Sub ConvertAssociations (theModel As Model, theClassName As String) 

 Dim AllClasses As ClassCollection 
 Dim theClass As Class 
 Dim theAssociations As AssociationCollection 
 Dim theRoles As RoleCollection 
 Dim theAssociatedClass As Class 
 Dim theAttribute As Attribute 
 Dim theRole As Role 
 Dim RedundantAssociations As New AssociationCollection 
 Dim theAssociation As Association 

 Set AllClasses = theModel.GetAllClasses() 
 ClsID = AllClasses.FindFirst(theClassName) 
 Set theClass = AllClasses.GetAt(ClsID) 
 'Print "theClass is ", theClass.Name 
 Set theAssociations = theClass.GetAssociations() 
 'Print "The number of Associations is "; theAssociations.Count 
 ' Clear out the redundant associations 
 RedundantAssociations.RemoveAll 
 For AssocID = 1 to theAssociations.Count 
  Set theAssociation = theAssociations.GetAt(AssocID) 
  Set theRole = theAssociation.Role2 
  If theRole.Navigable Then 
   Set theAssociatedClass = theAssociations.GetAt(AssocID).Role1.Class 
   Select Case theRole.Cardinality 
   Case "1" 
    Set theAttribute = theAssociatedClass.AddAttribute( _ 
     theAssociations.GetAt(AssocID).Role2.Name, theClassName, "") 
   Case "n" 
    theContainerClassProperty$ = theAssociations.GetAt(AssocID).Role2. _ 
     GetPropertyValue("cg","ContainerClass") 
    AttrType$ = theClassName & Right$(theContainerClassProperty$, _ 
     (Len(theContainerClassProperty$) - 12)) 
    Set theAttribute = theAssociatedClass.AddAttribute( _ 
     theAssociations.GetAt(AssocID).Role2.Name, AttrType$, "") 
   Case "0..1" 
    AttrType$ = theClassName & "*" 
    Set theAttribute = theAssociatedClass.AddAttribute( _ 
     theAssociations.GetAt(AssocID).Role2.Name, AttrType$, "") 
    theAttribute.InitValue = theAssociations.GetAt(AssocID).Role2. _ 
     GetPropertyValue("cg", "InitialValue") 
   Case Else 
    Set theAttribute = theAssociatedClass.AddAttribute( _ 
     theAssociations.GetAt(AssocID).Role2.Name, "", "") 
   End Select 
   theAttribute.Documentation = theRole.Documentation 
   RedundantAssociations.Add theAssociations.GetAt(AssocID) 
   TranscribeProperties theRole, theAttribute 
  End If 
 Next AssocID 
 For AssocID = 1 To RedundantAssociations.Count 
  Deleted = theClass.DeleteAssociation (RedundantAssociations.GetAt(AssocID)) 
 Next AssocID 

End Sub 

Sub Main 

 Dim theModel As Model 

 Set theModel = RoseApp.CurrentModel 

 'Viewport.Open 
 'Viewport.Clear 
  
 Dim f As String, theClassName As String 
 f$ = OpenFilename$("Open","Text Files:*.TXT") 
 If f$ <> "" Then 
  Open f$ For Input As #1 
  Do While Not EOF(1) 
   Line Input #1,theClassName$ 
   If ClassExists (theClassName$) Then ConvertAssociations theModel, theClassName$ 
  Loop 
  Close #1 
 End If 

End Sub