powerdesigner的domains导出与导入脚本

     powerdesigner的domains用来规范常用字段的设计挺好，但是我需要把domains在开发团队中共享却发现并没有导入导出功能，我希望能在不同的PDM中方便地导入导出，并且，当导出成excel后，还可以更好的维护（增删改），搜索了百度并没有发现类似的工具或脚本，所以只好参照脚本示例自己改了，测试成功！
     导出脚本：
    '******************************************************************************
'* File:     Export_Domains_to_excel.vbs
'* Purpose:  Scan PDM Model and display domains information
'            Export domains to Excel
'* Title:    
'* Category: 
'* Version:  1.0
'* Company:  SF Inc. 
'******************************************************************************


Option Explicit




Dim nb
'
' get the current active model
'
Dim mdl ' the current model
Set mdl = ActiveModel
If (mdl Is Nothing) Then
   MsgBox 'There is no Active Model'
End If
Dim fldr
Set Fldr = ActiveDiagram.Parent
nb =2
Dim HaveExcel
'Dim RQ
'RQ = MsgBox ('Is Excel Installed on your machine ?', vbYesNo + vbInformation,'Confirmation')
'if RQ= VbYes then
   HaveExcel= True
   ' Open & Create Excel Document
   Dim x1  '
   Set x1 = CreateObject('Excel.Application') 
   x1.Visible = True 
   x1.Workbooks.Add
   x1.Range('A1').Value = 'Class Name'
   x1.Range('B1').Value = 'Object Name'
   x1.Range('C1').Value = 'date type'
   x1.Range('D1').Value = 'date length' 
   x1.Range('E1').Value = 'precision' 
   x1.Range('F1').Value = 'mandatory' 
   x1.Range('G1').Value = 'default' 
   x1.Range('H1').Value = 'comment'    




'else
'   HaveExcel= false
'end if




ListObjects(fldr)
if HaveExcel= True Then '
      x1.Columns('A:D').EntireColumn.AutoFit 'To adjust the 
      'column's width.
end if   


Sub ListObjects(fldr)
   Dim obj ' running object
   For Each obj In fldr.domains
      DescribeObject obj
   Next


   ' go into the sub-packages
   Dim f ' running folder
   For Each f In fldr.Packages
      ListObjects f
   Next
End Sub




Sub DescribeObject(CurrentObject)
   if CurrentObject.ClassName ='Association-Class link' then exit sub
   'Export informations to the output list
   output 'Found '+CurrentObject.ClassName+' '+CurrentObject.Name+', Created by '+CurrentObject.Creator+' On '+mid(Cstr(CurrentObject.CreationDate),1,10)   
   if HaveExcel= True Then 'Export informations to Excel document      
      x1.Range('A'+Cstr(nb)).Value = CurrentObject.ClassName
      x1.Range('B'+Cstr(nb)).Value = CurrentObject.Name    
      x1.Range('C'+Cstr(nb)).Value = CurrentObject.DataType    
      x1.Range('D'+Cstr(nb)).Value = CurrentObject.length   
      x1.Range('E'+Cstr(nb)).Value = CurrentObject.Precision
      x1.Range('F'+Cstr(nb)).Value = CurrentObject.mandatory
      x1.Range('G'+Cstr(nb)).Value = CurrentObject.DefaultValueDisplayed
      x1.Range('H'+Cstr(nb)).Value = CurrentObject.comment 
      nb = nb+1
   end if
End Sub

导入domains脚本：
   '******************************************************************************
'* File:     Export_Domains_to_excel.vbs
'* Purpose:  Export domains to Excel
'* Title:    
'* Category: 
'* Version:  1.0
'* Company:  SF Inc. 
'******************************************************************************


Option Explicit




Dim nb
'
' get the current active model
'
Dim mdl ' the current model
Set mdl = ActiveModel
If (mdl Is Nothing) Then
   MsgBox 'There is no Active Model'
End If
Dim fldr
Set Fldr = ActiveDiagram.Parent
nb =2
Dim HaveExcel


   HaveExcel= True
   ' Open & Create Excel Document
   Dim x1  '
   Set x1 = CreateObject('Excel.Application') 
   'x1.Visible = True 
   '对文件的格式是有要求的，可以先导出一个作为模板
   x1.Workbooks.open('f:\domains.xlsx')
   


dim r,i,c,d
r=x1.activeSheet.usedRange.Rows.count
'从第二行读起,第一行标题
for i=2 to r
    set d=fldr.domains.createNew
    If not d is Nothing then
      ' Log message in the output
      output ' add domain: ' + d.Name
      ' Initialize domain object attributes
      d.Name =x1.activeSheet.cells(i,2).value
      d.Code =x1.activeSheet.cells(i,2).value
      d.DataType =x1.activeSheet.cells(i,3).value 
      '长度与精度统一由datatype字段设置  
      d.mandatory=x1.activeSheet.cells(i,6).value
      d.DefaultValue=x1.activeSheet.cells(i,7).value
      d.comment =x1.activeSheet.cells(i,8).value
    End If
next
x1.quit
set x1=nothing

 操作注意：导入对格式是有要求的，如果不调代码的话，就最好先导出一个excel作为模板，按格式增加其他domain，删除重复的,然后再导入；
 enjoy!^_^