powerdesigner中把表的描述复制到Name

'******************************************************************************
'* File：    comment2name.vbs
'* Author:   Jason Chen
'* Created:  2014
'* Modified: 2017/6
'* Version： 2.0
'* Comment： 把表中的描述信息复制为Name，增强可读性
'* Used：    打开物理模型，运行本脚本（Ctrl+Shift+X）
'* Comment：
'******************************************************************************
 
Option   Explicit
ValidationMode   =   True
InteractiveMode   =   im_Batch
 
Dim   mdl   '   the   current   model
 
'   get   the   current   active   model
Set   mdl   =   ActiveModel
If   (mdl   Is   Nothing)   Then
      MsgBox   "There   is   no   current   Model "
ElseIf   Not   mdl.IsKindOf(PdPDM.cls_Model)   Then
      MsgBox   "The   current   model   is   not   an   Physical   Data   model. "
Else
      ProcessFolder   mdl
End   If
 
Private   sub   ProcessFolder(folder)
On Error Resume Next
      Dim   Tab   'running     table
      for   each   Tab   in   folder.tables
            if   not   tab.isShortcut   then
                  tab.name = tab.code & " " & tab.comment
                  Dim   col   '   running   column
                  for   each   col   in   tab.columns
                  if col.comment="" then
                  else
                     dim colComment
                     colComment = col.comment
                     dim index
                     dim indexArray(9) '排除掉"X"后的文本
                     indexArray(0) = InStr(colComment, "：")
                     indexArray(1) = InStr(colComment, vbcrlf)
                     indexArray(2) = InStr(colComment, ":")
                     indexArray(3) = InStr(colComment, "(")
                     indexArray(4) = InStr(colComment, "【")
                     indexArray(5) = InStr(colComment, "[")
                     indexArray(6) = InStr(colComment, "（")
                     indexArray(7) = InStr(colComment, "，")
                     indexArray(8) = InStr(colComment, " ")
                     index = getArrMinValueIndex(indexArray)
 
                     if index > 0 then
                        Output index
                        colComment = Mid(colComment, 1, index-1)
                     end if
                     col.name = colComment
                  end if
                  next
            end   if
      next
 
      Dim   view   '视图
      for   each   view   in   folder.Views
            if   not   view.isShortcut   then
                  view.name   =   view.comment
            end   if
      next
 
      '   go   into   the   sub-packages
      Dim   f   '   running   folder
      For   Each   f   In   folder.Packages
            if   not   f.IsShortcut   then
                  ProcessFolder   f
            end   if
      Next
end   sub
 
'查找最近一个匹配的字符
Function getArrMinValueIndex(ByVal arr)
        Dim ix, itemMin
        itemMin = 0
        For ix = 1 To UBound(arr)
            If arr(ix) > 0 and (itemMin = 0 or itemMin > arr(ix)) Then
                itemMin = arr(ix)
            End If
        Next
        getArrMinValueIndex = itemMin
End Function