Как сохранить принадлежнсть слоям в Сorel ?

  • Автор темы Автор темы Ira_S
  • Дата начала Дата начала
Статус
Закрыто для дальнейших ответов.

Ira_S

Участник
Топикстартер
Сообщения
4
Реакции
0
Такая проблема: группируя несколько обьектов, с последующей их разгруппировкой, объекты которые ранее принадлежали разным слоям, при этом групируются/разрупировываються в один слой (текущий). Можно ли каким-нибудь образом сохранить принадлежность к слоям при group/ungroup ?
 
Ответ: Как сохранить принадлежнсть слоям в Сorel ?

Ira_S сказал(а):
Такая проблема: группируя несколько обьектов, с последующей их разгруппировкой, объекты которые ранее принадлежали разным слоям, при этом групируются/разрупировываються в один слой (текущий). Можно ли каким-нибудь образом сохранить принадлежность к слоям при group/ungroup ?
Нет, нельзя. Сие возможно только в FreeHand.
 
Ответ: Как сохранить принадлежнсть слоям в Сorel ?

varans сказал(а):
Можно сделать нечто подобное. Если выделить несколько (не один !) объектов, расположенных на разных уровнях и просто забрать в клипбоард, а потом вставить, то объекты окажутся на одном уровне, но соответственно сгруппироваными.
 
Ответ: Как сохранить принадлежнсть слоям в Сorel ?

Эт нужно макрос писать, который при группировке будет сохранять во внутренних тегах объектов название слоя. При разгруппировке он будет назначать из тегов. Вроде сделать несложно. ЕСЛИ НУЖНО еще кому-то
 
Ответ: Как сохранить принадлежнсть слоям в Сorel ?

Вот если бы объекты и в группе принадлежность к слоям (со своими свойствами) сохраняли, это была бы песня. А так... не знаю.
 
Ответ: Как сохранить принадлежнсть слоям в Сorel ?

knower сказал(а):
Вот если бы объекты и в группе принадлежность к слоям (со своими свойствами) сохраняли, это была бы песня. А так... не знаю.
всмысле "не знаю" нужен ли такой макрос?
Я вот тоже таким никогда пользоваться не собирался, но я не показатель, у меня процесс такой, что слои вообще не нужны. Но мне кажется что по условиям поставленным в начальном посте написать макрос совсем не сложно, только вот непонятно нужен ли он в такой функциональности
 
Ответ: Как сохранить принадлежнсть слоям в Сorel ?

Как варианты можно пользоваться:
1) экспортом-импортом в cmx, с возможными сопутствующими накладками.
2) макросами типа Save-Restore selection (использовать вместо группировки сохраненный Selection set)
 
Ответ: Как сохранить принадлежнсть слоям в Сorel ?

wOxxOm->
ОЧЕНЬ нужен
 
Ответ: Как сохранить принадлежнсть слоям в Сorel ?

Lev->
Save-Restore selection я знаю, но это немного не то.
 
Ответ: Как сохранить принадлежнсть слоям в Сorel ?

Код очень простой и быстрый, много строчек только потому, что я в него добавил визуальный фидбэк и оптимизацию выполнения, чтоб быстро работал с любым количеством объектов. В список отмены помещается как и ожидалось, одна операция, вне зависимости от кол-ва объектов.

Прерывать можно безопасно по Escape, (а принудительно - если я чтото недоглядел в коде - по Ctrl-Break/Pause, и сразу писать мне, что ошибка ;-)

GroupAndSaveLayers - группирует выделенное, сохраняя во внутренних свойствах объектов принадлежность к слоям

UnGroupAndAssignLayers - берет все выделенные объекты и каждый, буде он группа, разгруппировывает и распихивает объекты по слоям, используя сохраненную ранее информацию во внутренних свойствах объектов, записанную первым макросом GroupAndSaveLayers.

Надо иметь ввиду, что я написал так, что сохраняется имя слоя - поэтому если переименуете слой, то при разгруппировке UnGroupAndAssignLayers увидите сообщение, что некоторые слои не найдены, их названия и общее количество объектов, которые рагруппировались на текущий слой

Код:
Sub GroupAndSaveLayers()
 Dim sh As Shape, sr As New ShapeRange, stat As AppStatus, i&, step&, cnt&
 
 If ActiveShape Is Nothing Then Beep: Exit Sub
 
 Set sr = ActiveSelectionRange
 
 Set stat = Application.Status
 stat.BeginProgress CanAbort:=True
 stat.SetProgressMessage "Group and save layers assignment"
 cnt = sr.Count: step = cnt \ 100: If step = 0 Then step = 1
 
 Optimization = True: EventsEnabled = False
 ActiveDocument.PreserveSelection = False
 ActiveDocument.BeginCommandGroup "Group and save layer assignment"
 
 For Each sh In sr
 i = i + 1
 sh.Properties("Layer", 0) = sh.Layer.Name
 If i Mod step = 1 Then stat.Progress = i / cnt * 100: _
 If stat.Aborted Then Exit For
 Next
 
 ActiveDocument.PreserveSelection = True
 EventsEnabled = True: Optimization = False
 
 sr.Group.CreateSelection
 
 stat.EndProgress
 ActiveDocument.EndCommandGroup
 End Sub

Код:
Sub UnGroupAndAssignLayers()
 Dim sh As Shape, ssh As Shape, ln$, L As Layer
 Dim lErr$, errCnt&, i&, j&, cnt&, cntOrig&, step&
 Dim sr As New ShapeRange, ssr As ShapeRange, srU As New ShapeRange
 
 Set sr = ActiveSelectionRange
 cntOrig = sr.Count: If cntOrig = 0 Then Beep: Exit Sub
 
 Set stat = Application.Status
 stat.BeginProgress CanAbort:=True
 
 Optimization = True: EventsEnabled = False
 ActiveDocument.PreserveSelection = False
 ActiveDocument.BeginCommandGroup "Ungroup and assign layers"
 
 On Error GoTo ErrLayer
 For Each sh In sr
 i = i + 1
 If sh.Type = cdrGroupShape Then
 Set ssr = sh.UngroupEx: srU.AddRange ssr
 j = 0: cnt = ssr.Count: step = cnt \ 100: If step = 0 Then step = 1
 stat.SetProgressMessage "Smart ungroup " + _
 IIf(cntOrig = 1, "", "shape # " + CStr(i) + " / " + CStr(cntOrig))
 
 For Each ssh In ssr
 j = j + 1
 If j Mod step = 1 Then stat.Progress = j / cnt * 100: _
 If stat.Aborted Then Exit For
 
 ln = ssh.Properties("Layer", 0)
 If ln <> "" Then
 If ln = "Desktop" _
 Then Set L = ActiveDocument.MasterPage.Layers("Desktop") _
 Else Set L = ActivePage.Layers(ln)
 If Not L Is Nothing Then ssh.Layer = L
 End If
SkipErr: Next
 
 Else ' just a shape, add it to final selection
 srU.Add sh
 End If
 If stat.Aborted Then Exit For
 Next
 
 stat.EndProgress
 ActiveDocument.EndCommandGroup
 ActiveDocument.PreserveSelection = True
 EventsEnabled = True: Optimization = False
 
 srU.CreateSelection
 Application.Refresh
 If Not CorelDRAW.CorelScript Is Nothing Then _
 CorelDRAW.CorelScript.RedrawScreen
 
 If errCnt > 0 Then _
 MsgBox "Layers not found: " + lErr + vbCrLf + _
 CStr(errCnt) + " shapes referenced missing layers" + vbCrLf + vbCrLf + _
 "Ungroupped to " + ActiveLayer.Name
 Exit Sub
ErrLayer:
 err.Clear: lErr = lErr + ln + ", ": errCnt = errCnt + 1: Resume SkipErr
 End Sub
 
Ответ: Как сохранить принадлежнсть слоям в Сorel ?

...если переименуете слой, то при разгруппировке UnGroupAndAssignLayers увидите сообщение, что некоторые слои не найдены, их названия и общее количество объектов, которые рагруппировались на текущий слой...
Может стоит заново создать слой с потерянным именем и переместить объекты туда?
 
Ответ: Как сохранить принадлежнсть слоям в Сorel ?

lev сказал(а):
Может стоит заново создать слой с потерянным именем и переместить объекты туда?
Это хорошая идея! но это ж кому как и смотря когда, вроде надо бы сделать с какими-то опциями или просто модификации этого макроса для нескольких случаев -
если все оставить на активном,
если создать один слой с потерянными,
если создать все потерянные слои, сколько надо

я вот еще добавлю переходы (для клавы) по слоям как в Photoshop наверное - Alt [ , ] , Ctrl [ , Ctrl ].
 
Ответ: Как сохранить принадлежнсть слоям в Сorel ?

wOxxOm СПАСИБО ОГРОМНОЕ !
пойду тестить
 
Статус
Закрыто для дальнейших ответов.