Тема: Acad Drawing -> Image
Как создать image заданного размера из чертежа AutoCAD'a?
Информационный портал для профессионалов в области САПР
Вы не вошли. Пожалуйста, войдите или зарегистрируйтесь.
Форумы CADUser → Программирование → VBA → Acad Drawing -> Image
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Как создать image заданного размера из чертежа AutoCAD'a?
> VadimR
Заданного размера не получится, можно
создать рисунок выделенных рамкой объектов
но к сожалению он будет пропорционален
размерам экрана. После этого нужна ручная
доводка напильником:
Option Explicit Sub ExportWindowToImage() Dim ptVarLow As Variant Dim ptVarTop As Variant ' Работаем с активным документом With ThisDrawing ptVarLow = .Utility.GetPoint(, _ vbCrLf & "Specify first corner point: ") ptVarTop = .Utility.GetCorner(ptVarLow, _ vbCrLf & "Specify other corner point: ") ' Сокращенное имя документа с расширением Dim dwgName As String dwgName = .Name ' Получаем имя документа без расширения dwgName = Left$(dwgName, Len(dwgName) - 4) 'Удаляем все наборы из коллекции наборов документа ' если таковые были созданы ранее: With .SelectionSets While .Count > 0 .Item(0).Delete Wend End With ' Создаем пустой набор выбора и добавляем ' его в коллекцию наборов документа Dim oSset As AcadSelectionSet Set oSset = .SelectionSets.Add("$GooglyMoogly$") ' Выбираем нужные объекты на экране рамкой oSset.Select acSelectionSetWindow, ptVarLow, ptVarTop ' Задаем имя папки куда экспортируем файл ' (наклонный слэш на конце имени) Dim folderName As String folderName = "C:\MyVBA\" ' Задаем имя файла для экспорта без расширения ' (без наклонного слэша) Dim targName As String targName = folderName & dwgName ' Задаем расширениe файла (BMP, WMF, SAT - см. Help) Dim extStr As String extStr = "BMP" ' Непосредственно экспорт файла .Export targName, extStr, oSset ' Удаляем набор выбора из документа ' (это действие не удаляет объекты на экране) oSset.Delete ' Удаляем ссылку на переменную 'oSset' Set oSset = Nothing ' Завершаем работу с документом End With End Sub
~'J'~
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Форумы CADUser → Программирование → VBA → Acad Drawing -> Image
Форум работает на PunBB, при поддержке Informer Technologies, Inc