Сохранить объекты в разные файлы

Форум: 
Версия программы: 
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.

ну шото прям индийский копипэйст какойто :)))
давненько я не брал в руки шашек, а уж вижуалбейчиковых ваще не трогал, но попробую поискать как можно узнавать размер объекта и как перебрать их все.

Страницы