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