Тема: распределение объектов по слоям. проблемы с размерами.
Господа! Помогите решить проблему:
надо объекты чертежа разбросать по слоям в зависимости от типа объекта - все линии контуров - на один слой, текст - на другой, размеры - на третий и т. д.
Чертеж может иметь блоки со вставленными в них Blockreferencами и XREFы с чем угодно - вплоть до блоков, вложенных в другие блоки, XREFы и т. д.
Все переносится по слоям замечательно, таким способом:
1) сначала поиск по всем блокам и bind всех Xrefов в рекурсии.
2) поиск всех объектов Modelspacа и в зависимости от типа - распределение по слоям.
3) Опять по каждому блоку выбор всех объектов и распределение по слоям.
но:
При заморозке слоя Текст замораживаются и размерные тексты, хотя сами размерные блоки лежат на слое Размеры. При заморозке слоя контур замораживаются линии размерных блоков, хотя, опять же, блоки лежат на другом слое. Лишь при заморозке слоя Размеры и тектовые блоки, и линии, хорошо замораживаются и размораживаются, не затрагивая объекты на других слоях.
Речь идет о размерных блоках, входящих в блоки чертежа разного уровня вложения.
Текст обрабатывался так:
Public Sub texttranslate(aobj As AcadEntity)
Dim layers As AcadLayers
Dim layer As AcadLayer
Dim OldColor As AcColor
Dim ocBlue As Long
Dim ocGreen As Long
Dim ocRed As Long
Set layers = ThisDrawing.layers
Dim color As AcadAcCmColor
Set color = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor.16")
Dim flagWhiteBlackByLayer As Boolean
Set layer = layers.Item(aobj.layer)
If aobj.TrueColor.ColorIndex = acWhite Then
flagWhiteBlackByLayer = True
End If
Select Case aobj.TrueColor.ColorIndex
Case acWhite, acByBlock
flagWhiteBlackByLayer = True
Case acByLayer
If layer.TrueColor.ColorIndex = acWhite Then
flagWhiteBlackByLayer = True
Else
flagWhiteBlackByLayer = False
ocBlue = layer.TrueColor.Blue
ocGreen = layer.TrueColor.Green
ocRed = layer.TrueColor.Red
End If
Case Else
flagWhiteBlackByLayer = False
ocBlue = aobj.TrueColor.Blue
ocGreen = aobj.TrueColor.Green
ocRed = aobj.TrueColor.Red
End Select
aobj.layer = "CustomerText"
If flagWhiteBlackByLayer = False Then
Call color.SetRGB(ocRed, ocGreen, ocBlue)
aobj.TrueColor = color
End If
aobj.Update
Set layers = Nothing
Set aobj = Nothing
Set color = Nothing
End SubРазмеры так:
Public Sub DimTranslate(aobj As AcadDimension) aobj.layer = "CustomerDim" aobj.Update End Sub
А линии контура примерно так же, как и текст.
Как добиться того, чтобы заморозка слоя контура не затрагивала размерные линии, а заморозка слоя текстов не затрагивала размерный текст?
Заранее всем благодарен за помощь
