Как программно изменить цвет столбца на диаграмме PowerDesigner 16 PDM

Я могу использовать VBA для циклического просмотра столбцов таблицы и изменения многих свойств, связанных с самим объектом столбца. Я ищу, чтобы изменить цвет выбранных столбцов таблицы, как показано на диаграмме PDM. Это можно сделать из пользовательского интерфейса, щелкнув столбец таблицы, чтобы выбрать его на диаграмме, затем щелкнуть правой кнопкой мыши, чтобы отобразить контекстное меню, затем выбрать «Формат подобъектов».


powerdesigner
person user3248578    schedule 30.04.2021    source источник
comment
Вы имеете в виду изменение цвета текста для одной колонки? Я сохранил PDM в виде XML-файла, и он указал мне на атрибут ObjectCompositeSymbol.SubObjects.   -  person pascal    schedule 30.04.2021
comment
Спасибо, @pascal, но я искал код VBA. Для какого объекта доступен атрибут ObjectCompositeSymbol?   -  person user3248578    schedule 01.05.2021
comment
Я искал в справке PD OLE. Я предполагаю, что символ таблицы получен из ObjectCompositeSymbol; Я не уверен, как еще, но вы можете перечислить символы из диаграммы и из самой таблицы; также из TableSymbol вы можете использовать Object для проверки объекта, связанного с символом...   -  person pascal    schedule 01.05.2021

Ответы (1)


arrow_upward
1
arrow_downward

Вот пример, который делает это с некоторыми произвольными критериями, чтобы записать красным цветом некоторые столбцы в физической модели данных, когда их имя содержит b... с использованием атрибута ObjectCompositeSymbol.SubObjects.

option explicit
const workfont = "Arial,8,N,255,0,0"
dim diags: set diags = createobject("Scripting.Dictionary")
dim m : set m = activemodel
dim t
for each t in m.tables
   ' public name of subobjects: Column; 0: display all
   dim sb : sb = "Column 0" + vbcrlf
   dim c,some : some = false
   for each c in t.columns
      ' our criteria is: column name contains a b
      dim match : match = instr(lcase(c.name),"b") <> 0
      if match then
         sb = sb + "{"+ c.GetAttribute("ObjectID")+"} " + workfont + vbcrlf
         some = true
      end if
   next
   if not some then sb = ""
   ' apply subobjects coloring
   dim s
   for each s in t.symbols
      if s.subobjects <> sb then
         s.subobjects = sb
         if not diags.exists(s.diagram) then diags.add s.diagram,0
      end if
   next
next
if diags.count > 0 then
   dim d
   for each d in diags.keys
      output "... redraw "+d.name
      d.RedrawAllViews
   next
end if

Результат после выполнения скрипта

person pascal    schedule 18.05.2021