Option Explicit
ValidationMode = True
InteractiveMode = im_Batch

Dim mdl ' the current model

' get the current active model
Dim Model
Set Model = ActiveModel
If (Model Is Nothing) Or (Not Model.IsKindOf(PdOOM.cls_Model)) Then
   MsgBox "The current model is not an OOM model."
Else
   ' Get the Classes collection
   Dim ModelClasses
   Set ModelClasses = Model.Classes
   Output "The model '" + Model.Name + "' contains " + CStr(ModelClasses.Count) + " classes."
   Output ""
   
   ShowProperties Model
'   Dim cls
'   set cls = ModelClasses.item(0)
'   ShowOperations cls

End If

Sub ShowProperties(package)
   ' Show classes of the current model/package
   Dim noClass
   noClass = 1
   ' For each class
   Dim cls
   For Each cls In package.Classes
      ShowClass cls, noClass
      noClass = noClass + 1
   Next
   
   ' Show classes in the sub-packages
   Dim subpackage
   For Each subpackage In package.Packages
      If Not subpackage.IsShortcut Then
         ShowProperties subpackage
      ElseIf Not subpackage.External Then
         ' Accept internal shortcut of packages
         ShowProperties subpackage
      End If
   Next
   
End Sub

Sub ShowClass(cls, noClass)
   If IsObject(cls) Then
      Dim bShortcutClosed
      bShortcutClosed = false
      If cls.IsShortcut Then
      	 If Not (cls.TargetObject Is Nothing) Then
            ' Show properties of the target class
            Set cls = cls.TargetObject
         Else
            ' The target model is not opened (closed or not found)
            bShortcutClosed = true
         End If
      End If
   
      ' Show properties
      Output "================================"
      Output "Class " + CStr(noClass) + ":"
      Output "================================"
      If Not bShortcutClosed Then
      		cls.Comment = cls.Name
      
      

         ' Show attributes
         ShowAttributes cls

         ' Show operations
         ShowOperations cls
      Else
         Output "The target class of the shortcut " + cls.Code + " is not accessible."
         Output ""
      End If
   End If
End Sub


'-----------------------------------------------------------------------------
' Show class attributes
'-----------------------------------------------------------------------------
Sub ShowAttributes(cls)
   Dim noAttr
   noAttr = 1
   If IsObject(cls) Then
      Dim attr
      For Each attr In cls.Attributes
         If Not attr.IsShortcut Then
         	
         		attr.Comment = attr.Name
           
         End If
      Next
   End If
End Sub

Sub ShowOperations(cls)
   Dim noOper
   noOper = 1
   If IsObject(cls) Then
      Dim oper
      For Each oper In cls.Operations
         'If Not oper.IsShortcut Then
           
          if oper.comment="" then
  				
  				oper.comment = oper.Name
  				end if

         'End If
      Next
   End If
End Sub

Comments are closed.

Post Navigation