'TITLE: GET RELATED ENTITIES 'DESCRIPTION: This macro selects the related parents and/or child ' of the selected tables. To use the macro lasso a group of ' entities on the diagram or select them in the diagram tree, then ' right click on the macro to execute. Parents and children will ' be selected depending if the option is checked. This macro can ' be used to assist in submodel creation. 'MODIFY DATE: 5/10/02 'ER.Studio variables Dim ersMdl As Model Dim ersDiag As Diagram Dim ersSubmdl As SubModel Dim ersEnt As Entity Dim ersSO As SelectedObject Dim ersRel As Relationship 'Array variables Dim arrParentTbls() As String Dim arrChildTbls() As String Dim arrSourceTbls() As String Sub fillSourceFromSelected (source As Variant) ReDim source (0 To ersSubmdl.SelectedObjects.Count - 1) As String Dim i As Integer i = 0 For Each ersSO In ersSubmdl.SelectedObjects If ersSO.Type = 1 Then Set ersEnt = ersMdl.Entities.Item(ersSO.ID) If ersMdl.Logical = True Then source(i) = ersEnt.EntityName Else source(i) = ersEnt.TableName End If i = i + 1 End If Next End Sub Sub getParents (source As Variant, parents() As String) Dim i,j As Integer Dim count As Integer count = 0 i = 0 j = 0 For i = 0 To UBound(source) If source(i) <> "" Then Set ersEnt = ersMdl.Entities.Item(source(i)) count = count + ersEnt.ChildRelationships.Count If ersEnt.ChildRelationships.Count <> 0 Then ReDim Preserve parents(0 To count) As String For Each ersRel In ersEnt.ChildRelationships If ersMdl.Logical = True Then parents(j) = ersRel.ParentEntity.EntityName Else parents(j) = ersRel.ParentEntity.TableName End If j = j + 1 Next Else ReDim Preserve parents ( count ) As String End If End If Next End Sub Sub getChildren (source As Variant, children() As String) Dim i,j As Integer Dim count As Integer count = 0 i = 0 j = 0 For i = 0 To UBound(source) If source(i) <> "" Then Set ersEnt = ersMdl.Entities.Item(source(i)) count = count + ersEnt.ParentRelationships.Count If ersEnt.ParentRelationships.Count <> 0 Then ReDim Preserve children(0 To count) As String For Each ersRel In ersEnt.ParentRelationships If ersMdl.Logical = True Then children(j) = ersRel.ChildEntity.EntityName Else children(j) = ersRel.ChildEntity.TableName End If j = j + 1 Next Else ReDim Preserve children ( count ) As String End If End If Next End Sub Sub addEntities ( submdl As SubModel, newones As Variant ) Dim i As Integer Dim count As Integer count = UBound(newones) For i = 0 To count If newones(i) <> "" Then Set ersEnt = ersMdl.Entities.Item(newones(i)) submdl.SelectedObjects.Add(1, ersEnt.ID) End If Next End Sub Sub Main Debug.Clear Set ersDiag = DiagramManager.ActiveDiagram Set ersMdl = ersDiag.ActiveModel Set ersSubmdl = ersMdl.ActiveSubModel Begin Dialog UserDialog 320,98,"Get Related Entities",.GRTHandler ' %GRID:10,7,1,1 CheckBox 60,21,80,14,"Parents",.parentschbx CheckBox 180,21,80,14,"Children",.childrenchbx OKButton 40,56,90,21 CancelButton 190,56,90,21 End Dialog Dim dlg As UserDialog dlg.parentschbx = 1 dlg.childrenchbx = 1 If ersSubmdl.SelectedObjects.Count <> 0 Then If Dialog(dlg, -2) = -1 Then ' If ersSubmdl.MainSubModel = True Then fillSourceFromSelected arrSourceTbls Debug.Print "selected0" ' Else 'Debug.Print "sub " & dlg.submodelchbx ' If dlg.submodelchbx = 0 Then ' fillSourceFromSelected arrSourceTbls ' Debug.Print "selected1" ' Else ' ersSubmdl.EntityNames (entnames, srcCount) ' arrSourceTbls = entnames ' Debug.Print "all" ' End If ' End If Debug.Print "Source Tables: " For i = 0 To UBound(arrSourceTbls) Debug.Print arrSourceTbls(i) Next If dlg.parentschbx = 1 Then getParents arrSourceTbls, arrParentTbls Debug.Print UBound(arrParentTbls) If UBound(arrParentTbls) > 0 Then Debug.Print "ParentTables: " For i = 0 To UBound(arrParentTbls) Debug.Print arrParentTbls(i) Next addEntities ersSubmdl, arrParentTbls End If End If If dlg.childrenchbx = 1 Then getChildren arrSourceTbls, arrChildTbls If UBound(arrChildTbls) > 0 Then Debug.Print "childTables: " For i = 0 To UBound(arrChildTbls) Debug.Print arrChildTbls(i) Next addEntities ersSubmdl, arrChildTbls End If End If End If Else MsgBox("Please select entities in a submodel or in the Main Model.",,"ERROR!") End If End Sub
Rem See DialogFunc help topic for more information. Private Function GRTHandler(DlgItem$, Action%, SuppValue&) As Boolean Select Case Action% Case 1 ' Dialog box initialization ' If ersSubmdl.MainSubModel = True Then ' DlgEnable "submodelchbx",False ' End If Case 2 ' Value changing or button pressed Rem GRTHandler = True ' Prevent button press from closing the dialog box Case 3 ' TextBox or ComboBox text changed Case 4 ' Focus changed Case 5 ' Idle Rem GRTHandler = True ' Continue getting idle actions Case 6 ' Function key End Select End Function