Sub Example_HasExtensionDictionary()
Dim DrawingObject As AcadObject
Dim ExtensionDictionaryResults As String
If ThisDrawing.ModelSpace.Count = 0 Then
MsgBox "There are no objects in the current drawing."
Exit Sub
End If
For Each DrawingObject In ThisDrawing.ModelSpace
Select Case DrawingObject.HasExtensionDictionary
Case True
Dim eDictionary As AcadDictionary
Set eDictionary = DrawingObject.GetExtensionDictionary
Dim sentityObj As Object
Set sentityObj = eDictionary.GetObject("AcDbContextDataManager")
Set sentityObj = sentityObj.GetObject("ACDB_ANNOTATIONSCALES")
' тут в sentityObj содержится список аннототивных масштабов
' вот только его не получить
'добавить в этот список можно как то вот так
' но вот что добавлять, не понятно!
' Dim keyName As String
' Dim className As String
' Dim customObj As AcadTableStyle
' keyName = "NewStyle"
' className = "AcDbTableStyle"
' Set customObj = sentityObj.AddObject(keyName, className)
ExtensionDictionaryResults = ExtensionDictionaryResults & _
DrawingObject.ObjectName & _
" has an associated Extension Dictionary" & vbCrLf
Case False
ExtensionDictionaryResults = ExtensionDictionaryResults _
& DrawingObject.ObjectName & _
" does not have an associated Extension Dictionary" & vbCrLf
End Select
Next
MsgBox ExtensionDictionaryResults
End Sub