Macro to change the entity color based on attachment binding

Hi,

have been struggling to figure this out, request your expertise please? I need to change the entity color based on the value present in one of the attachment bindings in the entity. I am struggling to loop through the entities and checking the value in attachment bindings. Would you mind sharing any of your ideas/code snippets pls?

Below is my example:

Let us say I have two entities Employee, Manager. I have added multiple attachment bindings to these entities - lets say Department, Band.  Wherever Department = "IT", I want to change that entity color to some color. Can you pls guide?

Below is my code. After I execute this macro, it shows as idle and nothing happens :( Immediate help will be very useful. Thanks in advance.

Entity Color Change.txt
Sub Main
	Dim MyDiagram As Diagram
	Dim MyModel As Model
	Dim MyEntityDisplay As EntityDisplay
	Dim MyEntity As Entity
	Dim MySubModel As SubModel
	Dim MyAttribute As AttributeObj
	Dim MySelObject As SelectedObject
	Dim MyAttachment As Attachment

	Dim ObjectName As String
	Dim ForeignKey As Boolean
	Dim Logical As Boolean
	Dim AttachmentModel_Name As String

	'Get the current diagram.

	Set MyDiagram = DiagramManager.ActiveDiagram

	'Get the current model.

	Set MyModel = MyDiagram.ActiveModel

	'Determine if the model is logical or physical.

	Logical = MyModel.Logical

	'Get the current submodel.

	Set MySubModel = MyModel.ActiveSubModel

	'Iterate through all the entity display objects in the
	'current SubModel And Select (highlight) all entities in
	'the SubModel.

	For Each MyEntityDisplay In MySubModel.EntityDisplays

		'In order to select (highlight) an entity object in
		'a submodel, we need to pass in the actual ID of the
		'entity object (not the entity display object) to
		'the 'Add' function of the SelectedObjects collection.

		'In order to get the ID of the actual entity object,
		'we get the name of the entity from the entity
		'display object, and then pass it to the 'Item' method
		'of the Entities collection.  This will allow us to get
		'the actual entity object.

		ObjectName = MyEntityDisplay.Name

		Set MyEntity = MyModel.Entities.Item(ObjectName)

		ID = MyEntity.ID

		'Now we actually add the entity to the SelectedObjects
		'collection.  This will highlight the entity on the screen.
		'The first parameter to 'Add' is the type.  In this case,
		'type is 1 (entity).  The second parameter is the ID of
		'the entity.

		MySubModel.SelectedObjects.Add(1, ID)

	Next MyEntityDisplay

	'Now, we iterate through all the selected entities in
	'the submodel and set the entity background color of
	'selected entities with foreign keys to red.

	For Each MySelObject In MySubModel.SelectedObjects

		'Get the object type - we are only concerned
		'with entities.

		ObjType = MySelObject.Type

		If ObjType = 1 Then

			' Get the ID for the selected object.

			ID = MySelObject.ID

			' Now get the actual entity object with this ID.
			' The model contains the collection of all the
			' entities.

			Set MyEntity = MyModel.Entities.Item(ID)

			'We need to the name of the entity.  We can use the
			'name to get the entity display object from the submodel.

			If Logical = True Then

				' If the model is logical, get the entity
				' name.

				ObjectName = MyEntity.EntityName
			Else

				' If the model is physical, get the table
				' name.

				ObjectName = MyEntity.TableName
			End If

			'Iterate through all the attributes in the entity
			'and see if there are any foreign keys.

			'For Each MyAttribute In MyEntity.Attributes

				'Determine if the attribute is a foreign key.

				For Each MyBoundAttachment In MyEntity.BoundAttachments
				
					Set MyAttachment = MyBoundAttachment.Attachment
					If MyAttachment.Name = "Entity Properties" Then
						If MyBoundAttachment.ValueCurrent = "Department" Then
							If MyBoundAttachment.ValueOverride = "IT" Then
								Set MyEntityDisplay = MySubModel.EntityDisplays.Item(ObjectName)
								MyEntityDisplay.BackgroundColor = RGB(255, 0, 255)
							End If
						Else
							MyEntityDisplay.BackgroundColor = RGB(0, 0, 255)
						End If
					End If
									
						
				Next MyBoundAttachment

			'Next MyAttribute

		End If

	Next MySelObject

	'Now we want to iterate through all the entity display
	'objects in the active submodel and deselect (unhighlight)
	'all entities in the submodel.

	'For Each MyEntityDisplay In MySubModel.EntityDisplays

		'In order to select (highlight) an entity object in
		'a submodel, we need to pass In the actual ID of the
		'entity object (not the entity display object) to
		'the 'Add' function of the SelectedObjects collection.

		'In order to get the ID of the actual entity object,
		'we first get the name of the entity from the entity
		'display object, and then pass that to the 'Item' method
		'of the Entities collection.  This will allow us to get
		'the actual entity object.

		'ObjectName = MyEntityDisplay.Name

		'Set MyEntity = MyModel.Entities.Item(ObjectName)

		'ID = MyEntity.ID

		'Now we actually add the entity to the SelectedObjects
		'collection.  This will highlight the entity on the screen.
		'The first parameter to 'Remove' is the type.  In this case,
		'type is 1 (entity).  The second parameter is the ID of
		'the entity.

		'MySubModel.SelectedObjects.Remove(1, ID)

	'Next MyEntityDisplay
End Sub

Parents
No Data
Reply
  • Perhaps this code snippet will help you:

    Dim objDiagram As Diagram
    Dim objModel As Model
    Dim objSubModel As SubModel
    Dim objEnt As Entity
    Dim oTableDisplay As EntityDisplay
    
    Const BLUE = 16777088 	' Blue		(128,255,255)
    
    .
    .
    .
    
    		For Each oTableDisplay In objSubModel.EntityDisplays
    			DoEvents
    			Set objEnt = oTableDisplay.ParentEntity 
    
    				For Each oAttach In objEnt.BoundAttachments
    					If oAttach.Attachment.Name = "Department" Then
    						If oAttach.ValueCurrent = "IT" Then
    							If oTableDisplay.BackgroundColor <> BLUE Then
    								oTableDisplay.BackgroundColor = BLUE
    							End If
    						Else 'if background is blue but attachment was removed, set back to white
    							If oTableDisplay.BackgroundColor = BLUE Then
    								oTableDisplay.BackgroundColor = WHITE
    							End If
    						End If
    					End If
    				Next
    
    		Next oTableDisplay

Children