I would like to tag entities with a custom metadata property so that I can then write a macro to set colour based on that attribute

Specifically, I want to add a custom metadata property on entities, called 'Entity Category', so that I can then write a macro to set the entity colour based on that attribute.

How to I define custom metadata properties?   I expected 'Attachments' to allow this somehow, but can't figure it out, and the Help is not helping.

  • Here are some seemingly relevant snippets from my TreeComplexityDiagram macro.  I'm sure there are numerous working examples as part of the sample code.  I'm just not familiar with what's all there.

    Const Usage     = Array("Entity / Table","Model")   ' List of object types eligible for attachments 

    ' --------------------------------------------------------------------------
    '                   GetAttachmentType
    ' Returns a pointer to the attachment type requested - creating it if needed.
    ' The type will have only the requested usages if the type is created but if
    ' the type already exists usages will only be added if needed.  Existing
    ' usages won't be deleted.
    ' --------------------------------------------------------------------------
    Function GetAttachmentType ( _
        InDiagram As Diagram, AttName, AttDesc, Usage() As Variant) As AttachmentType
        Dim DDictionary As Dictionary
        Set DDictionary = InDiagram.Dictionary
        Dim ATypes As AttachmentTypes
        Set ATypes = DDictionary.AttachmentTypes
        Dim AType As AttachmentType
        Set AType = ATypes.Item(AttName)
        If AType Is Nothing Then                     ' the type needs creating
            Set AType = ATypes.Add(AttName,AttDesc)
            Dim VABinding As ValidAttachmentBinding
            If Usage(0) <> "*" Then
                ' By default, every eligible object is bound.
                ' Get rid of those not explicitly requested.
                Dim Delete As Boolean
                Dim Use As String
                For Each VABinding In AType.ValidAttachmentBindings
                    Delete = True
                    For Each Use In Usage
                        If VABinding.ObjectType = Use Then Delete = False
                    If Delete = True Then AType.ValidAttachmentBindings.Remove(VABinding.ID)
            End If
        End If
        ' When type already exists the call may need to give new object types
        ' valid binding status
        For Each Use In Usage
            If AType.ValidAttachmentBindings.Item(Use) Is Nothing Then
            End If
        Set GetAttachmentType = AType
    End Function
    ' -----------------------------------------------------------------------------
    '                   GetAttachedProperty
    ' Returns a pointer to the attachment object requested - creating it if needed
    ' -----------------------------------------------------------------------------
    Function GetAttachedProperty(AType As AttachmentType, AName As String, ADesc As String) As Attachment
        Dim TheAttachment As Attachment
        Set TheAttachment = AType.Attachments.Item(AName)
        If TheAttachment Is Nothing Then
            Set TheAttachment = AType.Attachments.Add(AName,ADesc,"0",4)
        End If
        Set GetAttachedProperty = TheAttachment
    End Function

Reply Children
No Data