Сохранить объекты в разные файлы
lylyt / 18.08.2011, 20:32/00:41
Форум:
Версия программы:
15.1.0.588 (sp1)
Вопрос знатокам,
Есть векторный файл с кучей объектов, надо сохранить эти объекты в файлы по одному в каждый файл в виде обычного растра, например JPG и назвать файлы 001,002 => итд...
Если выполнять экспорт в ручную, получается уж очень муторно и долго.
Подскажите, как решить эту проблему.
макросом проще простого, но его нужно ещё написать )
Sancho профессионально пишет макросы, обратитесь к нему за помощью.
не обращайтесь, я на заказ больше не пишу — не благодарное дело
ну штатным макросером запиши ВРЕМЕННЫЙ макрос который экспортит с нужными настройками и потом выделяй и жми контрол+шифт+пэ(англ)и он тебе будет экспортить. правда в один и тот же файл :)а вот как его заставить спрашивать имя файла выпытывай у Санчо :)
У меня опыт в макросописании минимальный. Но удалось написать макрос для указанной задачи, только с привязкой к формату документа и к ориентации страницы (то есть объект на фоне страницы документа. Также мой макрос не предлагает выбор нужной папки (то есть будет сохранять только в папку, указанную в программном коде макроса).
Выкладывай, посмотрим
а почему с привязкой к странице?
у меня записанный экспортит только выделенный.
вот какой код там:
Sub TemporaryMacro()
' Recorded 23.08.2011
Dim OrigSelection As ShapeRange
Set OrigSelection = ActiveSelectionRange
OrigSelection.CreateSelection
Dim expflt As ExportFilter
Set expflt = ActiveDocument.ExportBitmap("Z:\МАКЕТЫ\test.jpg", cdrJPEG, cdrSelection, cdrRGBColorImage, 288, 374, 150, 150, cdrNormalAntiAliasing, False, False, False, False, cdrCompressionNone)
With expflt
.Progressive = False
.Optimized = False
.SubFormat = 0
.Compression = 10
.Smoothing = 10
.Finish
End With
End Sub
по идее можно програмно оббежать все объекты 1 уровня и экспортировать их в файлы по итератору :) тока как получить доступ к списку объектов и бегать по ним я еще не нашел.
Экспорт объектов зависит от третьего параметра функции ExportBitmap. cdrSelection экспортирует выделенные объекты, cdrCurrentPage - объекты на странице
Почему привязка к странице? По той же причине, что и в приведённом выше коде от mmgs, 288 и 374 — это размеры в пикселах выделенного объекта, на примере которого он записал макрос.
Поскольку размеры объектов разные, чтобы обойти это, я добавил второй слой с пустой рамкой по границам листа и каждый объект экспортирую в группе с этой пустой рамкой.
Поэтому в фрагменте кода, который можно продублировать хоть 100 раз всегда одини и те же размеры. Но вот имя файла (от 001 до 100) придётся в каждом фрагменте кода проставить вручную. На это уйдёт всего несколько минут. Конечно, число объектов должно быть меньше, чем количество продублированных фрагментов кода. В конце работы макрос выдаёт сообщение об ошибке (насчёт несоответствия числа объектов), которое просто игнорируем. Работает молниеносно, глаз не успевает моргнуть, как все файлы JPEG оказываются в папке. Конечно, недостаток в том, что для других форматов документа придётся применить другой, подкорректированный код.
Не сомневаюсь, что асы макросописания могут создать более компактный код. Зато этот был сделан за один вечер.
Sub Shape_to_File()
ActiveDocument.CreateShapeRangeFromArray(ActivePage.Layers("Слой 1").Shapes(1),
ActivePage.Layers("Слой 2").Shapes.All).CreateSelection
Dim expflt As ExportFilter
Set expflt = ActiveDocument.ExportBitmap("C:\Documents and
Settings\Алексей.DB273DХХХХХХХХХ\Мои документы\001.jpg", cdrJPEG, cdrSelection,
cdrRGBColorImage, 3035, 2008, 300, 300, cdrNormalAntiAliasing, False, False, True, False,
cdrCompressionNone)
With expflt
.Progressive = False
.Optimized = False
.SubFormat = 0
.Compression = 10
.Smoothing = 10
.Finish
End With
ActiveDocument.CreateShapeRangeFromArray(ActivePage.Layers("Слой 1").Shapes(2),
ActivePage.Layers("Слой 2").Shapes.All).CreateSelection
Set expflt = ActiveDocument.ExportBitmap("C:\Documents and
Settings\Алексей.DB273DХХХХХХХХХ\Мои документы\002.jpg", cdrJPEG, cdrSelection,
cdrRGBColorImage, 3035, 2008, 300, 300, cdrNormalAntiAliasing, False, False, True, False,
cdrCompressionNone)
With expflt
.Progressive = False
.Optimized = False
.SubFormat = 0
.Compression = 10
.Smoothing = 10
.Finish
End With
ActiveDocument.CreateShapeRangeFromArray(ActivePage.Layers("Слой 1").Shapes(3),
ActivePage.Layers("Слой 2").Shapes.All).CreateSelection
Set expflt = ActiveDocument.ExportBitmap("C:\Documents and
Settings\Алексей.DB273DХХХХХХХХХ\Мои документы\003.jpg", cdrJPEG, cdrSelection,
cdrRGBColorImage, 3035, 2008, 300, 300, cdrNormalAntiAliasing, False, False, True, False,
cdrCompressionNone)
With expflt
.Progressive = False
.Optimized = False
.SubFormat = 0
.Compression = 10
.Smoothing = 10
.Finish
End With
…………
End Sub
Жирным отмечены имена файлов и размеры страницы.
Естественно, путь для сохранения документа нужно указать свой.
Также надо не забыть в документе, к которому будет применяться этот макрос, добавить Слой 2 с рамкой по границам листа, абрис без цвета. Все объекты должны быть в Слое 1.
ну шото прям индийский копипэйст какойто :)))
давненько я не брал в руки шашек, а уж вижуалбейчиковых ваще не трогал, но попробую поискать как можно узнавать размер объекта и как перебрать их все.
Страницы