使用powerdesigner显示表和列的注释

‘使用说明：在PDM的视图中 按键：ctrl+shift+x，把代码贴到弹出对话框中然后点击run就行了

Option Explicit

ValidationMode = True

InteractiveMode = im_Batch

Dim system, file
Set system = CreateObject("Scripting.FileSystemObject")
Dim ForReading, ForWriting, ForAppending   '打开文件选项
ForReading   = 1 ' 只读
ForWriting   = 2 ' 可写
ForAppending = 8 ' 可写并追加
'打开文本文件,这个地方需要注意，必须在响应的位置新建这个文件，否则就会执行出错
Set file = system.OpenTextFile("d:\pdcomment.txt", ForWriting, true)


'判断当前model是否物理数据模型
Dim mdl
Set mdl = ActiveModel
If (mdl Is Nothing) Then
   MsgBox "处理对象无模型"
ElseIf Not mdl.IsKindOf(PdPDM.cls_Model) Then
   MsgBox "当前模型不是物理数据模型"
Else
   ProcessFolder mdl,file
End If
file.Close


'******************************************************************************
Private sub ProcessFolder(folder,file)


Dim i,j,k
i=0:j=0:k=0
'列数组，记录字段里不重复的comment
Dim ColumnComment()
Dim ColumnCommentNumber()
ReDim Preserve ColumnComment(i)
ReDim Preserve ColumnCommentNumber(i)


Dim tbl   '当前表
Dim col   '当前字段
dim curComment '当前字段comment
Dim regex '正则表达式
Set regex=New RegExp
'处理模型中的表
for each tbl in folder.tables
    if not tbl.isShortcut then
       if len(trim(tbl.comment))<>0 then
          '可以在这里显示table的comment
          regex.Pattern="

.∗

"
          If regex.Test(tbl.name) then
          else
            tbl.name = tbl.name+"["+trim(tbl.comment)+"]"
            end if
       end if


       '处理表中的列
       for each col in tbl.columns
           k = 0
           curComment = trim(col.comment)
           if len(curComment)<>0 then
              '遍历相异的comment数组
              for j = 0 to i
                  if ColumnComment(j) = curComment then
                     '如果找到相同的comment,则相关计数器加1
                     ColumnCommentNumber(j) = ColumnCommentNumber(j) + 1
                     k = j
                  end if
              Next
              '如果没有相同的comment,则k=0,此时ColumnCommentNumber(0)也为0
              '否则ColumnCommentNumber(k)不为0
              if ColumnCommentNumber(k) <> 0 Then


              regex.Pattern="

.∗

"
              If regex.Test(col.name) Then
              else
                 col.name =col.name+"["+curComment & cstr(ColumnCommentNumber(k))+"]"
                 End if
              Else
              regex.Pattern="

.∗

"
              If regex.Test(col.name) Then
              else
                 col.name = col.name+"["+curComment+"]"
             End if
                 'ColumnComment(0)、ColumnCommentNumber(0)永远为空
                 '将相异的comment记录添加到数组中
                 i = i + 1
                 ReDim Preserve ColumnComment(i)
                 ReDim Preserve ColumnCommentNumber(i)
                 ColumnComment(i) = curComment
                 ColumnCommentNumber(i) = 0
              end if
           else
              '写入文件中
              file.WriteLine "comment on column "+ tbl.name+"."+col.code+" is '';"
           end if
       next
    end if
    '由于不同表的name允许相同,因此此时重新初始化。
    '因为ColumnComment(0)、ColumnCommentNumber(0)为空，可以保留
    ReDim Preserve ColumnComment(0)
    ReDim Preserve ColumnCommentNumber(0)
    i=0:j=0:k=0


next


Dim view '当前视图
for each view in folder.Views
    if not view.isShortcut then
       '可以在这里显示view的comment
        regex.Pattern="

.∗

"
        If regex.Test(view.name) Then
        Else
       view.name = view.name+"["+view.comment+"]"
       End if
    end if
next


'对子目录进行递归
Dim subpackage 'folder
For Each subpackage In folder.Packages
    if not subpackage.IsShortcut then
       ProcessFolder subpackage , file
    end if
Next


end sub