''MACRO TITLE: AUTO-COMBINE SELECTED ENTITIES MACRO 'It will take all the attributes from all the selected entities 'and add them into one newly created entity. '----------------------------------------------------------------- 'GetAveragePoint/ 'This function will get the average x or y coordinate point among 'all selected entities. The second parameter determines whether 'to calculate the average x coordinate or the average y coordinate. Function GetAveragePoint(MyModel As Model, GetXPoint As Boolean) As Integer Dim ID As Integer Dim MyEntity As Entity Dim MySubModel As SubModel Dim MySelObject As SelectedObject Dim ObjectName As String Dim Logical As Boolean Dim MyEntityDisplay As EntityDisplay Dim TotalPoint As Integer Dim AveragePoint As Integer Dim Point As Integer Dim ObjType As Integer Point = -1 TotalPoint = -1 AveragePoint = -1 'Determine whether or not the model is logical. Logical = MyModel.Logical 'Get the current submodel. Set MySubModel = MyModel.ActiveSubModel 'Now iterate through all the selected objects and accumulate 'all the x or y coordinates for all selected entities. For Each MySelObject In MySubModel.SelectedObjects 'We are only concerned with entities, so check the 'object type. ObjType = MySelObject.Type If ObjType = 1 Then 'Get the ID of the selected object. ID = MySelObject.ID 'Now, get the entity object with this ID. Set MyEntity = MyModel.Entities.Item(ID) 'We need to get the entity name, so that we can 'get the corresponding entity display object from 'the submodel. 'If the model is logical, get the entity name. 'Otherwise, get the table name. If Logical = True Then ObjectName = MyEntity.EntityName Else ObjectName = MyEntity.TableName End If 'Get the entity display object from the submodel. Set MyEntityDisplay = MySubModel.EntityDisplays.Item(ObjectName) 'If the user wants the average x coordinate, then 'accumulate the x point of the selected entity. 'Otherwise, accumulate the y point of the selected 'entity. If GetXPoint = True Then Point = MyEntityDisplay.HorizontalPosition Else Point = MyEntityDisplay.VerticalPosition End If End If 'Add the current point to the total point value. TotalPoint = TotalPoint + Point Next MySelObject 'Get the count of selected entities. NumSelObjects = MySubModel.SelectedObjects.Count 'If the count is not 0, then get the average point value 'by dividing the total Point value from the number of 'selected objects. If NumSelObjects <> 0 Then AveragePoint = TotalPoint / NumSelObjects End If 'Return this average point value. GetAveragePoint = AveragePoint End Function Sub Main Dim MyDiagram As Diagram Dim MyModel As Model Dim MyEntity As Entity Dim MySubModel As SubModel Dim MySelObject As SelectedObject Dim MyAttribute As AttributeObj Dim MyEntityDisplay As EntityDisplay Dim LeftMostEntity As EntityDisplay Dim NewEntity As Entity Dim NewAttribute As AttributeObj Dim AttributeName As String Dim ID As Integer Dim Logical As Boolean Dim AttributePrefix As String Dim ObjType As Integer Dim PrimaryKey As Boolean Dim xPoint As Integer Dim yPoint As Integer Dim NewEntityName As String Dim Datatype As String Dim NullOption As String Dim DataScale As Integer Dim DataLength As Integer 'Get the current diagram. Set MyDiagram = DiagramManager.ActiveDiagram 'Get the current model. Set MyModel = MyDiagram.ActiveModel 'Get the current submodel. Set MySubModel = MyModel.ActiveSubModel 'Determine whether the model is logical. Logical = MyModel.Logical 'Get the average x coordinate value among all selected 'entities. xPoint = GetAveragePoint(MyModel, True) 'Get the average y coordinate value among all selected 'entities. yPoint = GetAveragePoint(MyModel, False) 'Create a new entity at the average x and y coordinate 'values. If xPoint <> -1 And yPoint <> -1 Then Set NewEntity = MyModel.Entities.Add(xPoint, yPoint) Else Exit Sub End If 'Iterate through all the selected entities and 'move' all the 'attributes from each selected entity into the new entity. 'The way we 'move' attributes from each original entity 'to the new entity is by creating a new attribute in the 'new entity and copying all the attribute properties from 'the old attribute to the new attribute. For Each MySelObject In MySubModel.SelectedObjects 'Get type of the selected object. ObjType = MySelObject.Type 'We are only concerned with entities, so 'check the object type. If ObjType = 1 Then 'Get the ID of the selected object. ID = MySelObject.ID 'Get the actual entity object with this ID Set MyEntity = MyModel.Entities.Item(ID) 'We get the original entity name for two reasons: '1) 'In order to create new, unique attribute names 'in the new entity we will take the old attribute name 'and add the original entity name as a prefix. 'This will ensure that all attribute 'names in the new entity will be unique. '2) 'Also, we want to create a new name for the new 'entity. The name will be all the original entity 'names appended together. 'If the model is logical, get the entity name. 'Otherwise, get the table name. If Logical = True Then AttributePrefix = MyEntity.EntityName NewEntityName = MyEntity.EntityName + "_" + NewEntityName Else AttributePrefix = MyEntity.TableName NewEntityName = MyEntity.TableName + "_" + NewEntityName End If 'Iterate through all the attributes in the original 'selected entity. For each attribute, we will create 'a new attribute in the new entity and copy the 'properties of the old attribute to the new attribute. For Each MyAttribute In MyEntity.Attributes 'We are only concerned with non-foreign key 'attributes. So, check the foreign key status 'of the attribute. If MyAttribute.ForeignKey = False Then 'To create the new attribute name, 'we have to get the old attribute name and 'prefix it with the original entity name. '(As explained above.) 'We want the attribute name if the model 'is logical. Otherwise, we want the column 'name. If Logical = True Then AttributeName = MyAttribute.AttributeName Else AttributeName = MyAttribute.ColumnName End If 'Create the new attribute name. AttributeName = AttributePrefix + "_" + AttributeName 'For now, we will just copy the primary 'key status, the datatype, and the null option 'from the old attribute to the new attribute. 'So, get these properties from the old 'attribute. PrimaryKey = MyAttribute.PrimaryKey Datatype = MyAttribute.Datatype DataLength = MyAttribute.DataLength DataScale = MyAttribute.DataScale NullOption = MyAttribute.NullOption 'Create the new attribute in the new entity. 'The original primary key status is passed in 'as a parameter to the Add function. Set NewAttribute = NewEntity.Attributes.Add(AttributeName, PrimaryKey) 'Now set the datatype and null option of the 'new attribute to match that of the old attribute. NewAttribute.Datatype = Datatype NewAttribute.DataLength = DataLength NewAttribute.DataScale = DataScale NewAttribute.NullOption = NullOption End If Next MyAttribute 'Now that we've copied all the attributes from 'the original selected entity, we can delete the 'original entity. MyModel.Entities.Remove(ID) End If Next MySelObject 'Change the name of the new entity. The new name 'equals all the original selected entity names appended 'together. NewEntity.EntityName = NewEntityName NewEntity.TableName = NewEntityName End Sub