powerdesigner中把表的描述复制到Name

Posted 2020-09-22 远方V3

‘******************************************************************************
‘* 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