Often times you add new columns to an entity, and you want to add them to multiple other entities, so this script will help speed things up.
also it will benefit in teaching how to make a collection in vbscript.
Option Explicit
Dim mdl ' the current model
Dim fldr
Dim oColect
Dim sSearchEntityFrom
Dim sSearchEntityTo
Dim objSourceEntity
Dim objDestinationEntity
Dim RQ
dim iCountChanged, iCountFields, iCountEntities
dim sCSVFile
Dim obj ' running object
Dim objFound
Set oColect = CreateObject( "Scripting.Dictionary" )
' get the current active model
Set mdl = ActiveModel
call mainProcedure
'-----------------------------------------------------------------------------
' Main function
'-----------------------------------------------------------------------------
sub mainProcedure()
If (mdl Is Nothing) Then
MsgBox "There is no Active Model"
exit sub
End If
If Not mdl.IsKindOf(PdCDM.cls_Model) Then
MsgBox "This is not CDM"
exit sub
end if
Set Fldr = ActiveDiagram.Parent
RQ = MsgBox ("Starting at Folder: " & Fldr.Name & " Is Run ?", vbYesNo + vbInformation,"Confirmation")
if RQ= VbNo then
exit sub
end if
iCountChanged=0
iCountEntities=0
iCountFields=0
Dim SourceEntity
Dim DestinationEntity
SourceEntity="Entity_55"
getEntity fldr, SourceEntity
Set objSourceEntity = objFound
if objSourceEntity is nothing = true then
output "Source Table not found in Model = " & SourceEntity
exit sub
end if
SelectAllDestinationEntities oColect
copyAttributesToAllTables fldr, oColect
MsgBox "Copyed Fields = " & iCountFields & " to " & iCountEntities & " Entities."
output "___Copyed Fields = " & iCountFields & " to " & iCountEntities & " Entities."
end sub
'-----------------------------------------------------------------------------
' Select All Destination Entities, that the columns will be copyed in them
'-----------------------------------------------------------------------------
Sub SelectAllDestinationEntities(oColect)
dim iInd
iInd = -1
iInd = iInd + 1 : oColect.Add iInd , "Entity_56"
iInd = iInd + 1 : oColect.Add iInd , "Entity_57"
iInd = iInd + 1 : oColect.Add iInd , "Entity_58"
End Sub
'-----------------------------------------------------------------------------
' Copy all attributes from Entity A, to all the tables in the collection, if the columns are not found in them
'-----------------------------------------------------------------------------
Sub copyAttributesToAllTables(pModel, oColect_)
dim i
For i = 0 to oColect_.Count - 1
getEntity pModel, oColect_.item(i)
Set objDestinationEntity = objFound
if objDestinationEntity is nothing = false then
'output "inserting into = " & objDestinationEntity.Code
copyAttributes objSourceEntity, objDestinationEntity
iCountEntities = iCountEntities + 1
else
output "Table not found in Model = " & oColect_.item(i)
end if
Next
oColect_.RemoveAll
End Sub
'-----------------------------------------------------------------------------
' Recursively search for the entity and return its object
'-----------------------------------------------------------------------------
function getEntity(parentFolder_, tableCode_)
Dim obj ' running object
For Each obj In parentFolder_.children
if obj.ClassName="Entity" then
if obj.Code=tableCode_ then
'MsgBox "Found: " & obj.Code , vbOk + vbInformation,"Info"
Set objFound = obj
Set getEntity = obj
exit function
end if
end if
Next
' go into the sub-packages
Dim innerFolder ' running folder
For Each innerFolder In parentFolder_.Packages
getEntity innerFolder, tableCode_
Next
End function
'-----------------------------------------------------------------------------
' Copy all attributes from Entity A, to B, if they are not found in B
'-----------------------------------------------------------------------------
Sub copyAttributes(entityFrom_, entityTo_)
if entityFrom_.ClassName <>"Entity" then exit sub
Dim attrOld
Dim attrNew
For Each attrOld In entityFrom_.Attributes
if isAttributeInEntity(entityTo_, attrOld.code) = false then
Set attrNew = entityTo_.Attributes.CreateNew
attrNew.Name = attrOld.Name
attrNew.code = attrOld.code
attrNew.Mandatory = attrOld.Mandatory
attrNew.Domain = attrOld.Domain
iCountFields= iCountFields + 1
End if
Next
End Sub
'-----------------------------------------------------------------------------
' Return true if attribute is found in entity
'-----------------------------------------------------------------------------
function isAttributeInEntity(entity_, attributeCode_)
if entity_.ClassName <>"Entity" then exit function
Dim attr
For Each attr In entity_.Attributes
if attr.Code = attributeCode_ then
isAttributeInEntity = true
exit function
end if
Next
isAttributeInEntity = false
End function
You must be a registered user to add a comment. If you've already registered, sign in. Otherwise, register and sign in.
User | Count |
---|---|
37 | |
10 | |
6 | |
4 | |
3 | |
3 | |
3 | |
2 | |
2 | |
2 |