'***Patrick Rutledge, Rational Support 10/98 
'This script adds a note to the diagram next to a class if the class 
'is from another package.  The note says "from " and the qualified 
'path to the class.  It was made specifically because the tag Rose 
'uses on the class icon doesn't qualify the package name. 
'This works on the active diagram, so you have to run it from a menu, 
'if you run it from the editor there is no active diagram 
  
'returns a fully qualified path to the class 
Function GetPathToClass(inClass As Class) As String 
 Dim aCat As Category 
 Set aCat = inClass.ParentCategory 
 path$ = aCat.name 
 While Not aCat.TopLevel() 
  Set aCat = aCat.ParentCategory 
  path$ = aCat.name & "::" & path$ 
 Wend 
 GetPathToClass = path$ 
End Function 

'returns true if the class is in the same package as the diagram 
Function SameParentCategory (inClass As Class, inDiag As Diagram) As Boolean 
 SameParentCategory = False 
 Dim testDiag As Diagram 

 Dim diags As ClassDiagramCollection 
 Set diags = inClass.ParentCategory.ClassDiagrams 
 For i% = 1 To diags.Count 
  Set testDiag = diags.GetAt(i%) 
  If inDiag Is testDiag Then 
   SameParentCategory = True 
   Exit Function 
  End If 
 Next i% 
End Function 

'if one doesn't exist, adds a "from somepackage" note to diagram next to class icon 
Sub AddNameNote (inDiag As Diagram, inClass As Class, inView As RoseItemView) 
 Dim note As NoteView 

 qName$ = "from " & GetPathToClass(inClass) 

 Set note = inDiag.AddNoteView(qName$, 1) 
 note.YPosition = inView.YPosition - (inView.height/2) - 70 
 note.XPosition = inView.XPosition - (note.width/2) 
End Sub 

Sub Main 
 Dim diag As Diagram 
 Dim aView As RoseItemView 
 Dim aClass As Class 
 Dim aClassView As ClassView 
  
 Set diag = RoseApp.CurrentModel.GetActiveDiagram() 
 If diag Is Nothing Then 
  MsgBox "No active diagram" 
  Exit Sub 
 End If 
  
  For i% = 1 To diag.ItemViews.Count 
  Set aView = diag.ItemViews.GetAt(i%) 
  If aView.CanTypeCast(aClassView) Then 
   Set aClass = aView.Item.TypeCast (aClass) 
   If Not SameParentCategory(aClass, diag) Then 
    AddNameNote diag, aClass, aView 
   End If 
  End If 
 Next i% 
 MsgBox "Done" 
End Sub