Индивидуальные очистные сооружения: К классу индивидуальных очистных сооружений относят сооружения, пропускная способность которых...
Своеобразие русской архитектуры: Основной материал – дерево – быстрота постройки, но недолговечность и необходимость деления...
Топ:
Генеалогическое древо Султанов Османской империи: Османские правители, вначале, будучи еще бейлербеями Анатолии, женились на дочерях византийских императоров...
Установка замедленного коксования: Чем выше температура и ниже давление, тем место разрыва углеродной цепи всё больше смещается к её концу и значительно возрастает...
Марксистская теория происхождения государства: По мнению Маркса и Энгельса, в основе развития общества, происходящих в нем изменений лежит...
Интересное:
Отражение на счетах бухгалтерского учета процесса приобретения: Процесс заготовления представляет систему экономических событий, включающих приобретение организацией у поставщиков сырья...
Аура как энергетическое поле: многослойную ауру человека можно представить себе подобным...
Лечение прогрессирующих форм рака: Одним из наиболее важных достижений экспериментальной химиотерапии опухолей, начатой в 60-х и реализованной в 70-х годах, является...
Дисциплины:
2021-06-30 | 40 |
5.00
из
|
Заказать работу |
Чтобы использовать приведенные примеры не в VBA а в VB следует, во-первых, сослаться на библиотеку типов, во-вторых заменить все ссылки ThisDrawing Для этого определить переменную для приложения AutoCAD (myApp) и для активного документа (myDoc). Если AutoCAD запущен, метод GetObject возвращает объект AutoCAD Application. Если AutoCAD не запущен, то вызывается обработчик ошибок. Затем метод CreateObject пытается создать объект AutoCAD Application, как в следующем примере:
Sub ConnectToAcad() Dim acadApp As AcadApplication On Error Resume Next Set acadApp = GetObject(, "AutoCAD.Application") If Err Then Err.Clear Set acadApp = CreateObject("AutoCAD.Application") If Err Then MsgBox Err.Description Exit Sub End If MsgBox "Запушен " + acadApp.Name + " версии " + acadApp.VersionEnd Sub' Далее установить ссылку на Document object в приложении AutoCADDim acadDoc as AcadDocumentSet acadDoc = acadApp.ActiveDocumentЗдесь уже используем acadDoc-переменную для ссылки на текущий рисунок AutoCAD. Если запущены несколько сеансов, AutoCAD-функция GetObject возвращает первое вхождение из Windows Running Object Table (ROT).
Следующий пример демонстрирует создание линии в VB и VBA
Sub AddLineVBA() Dim lineObj As AcadLine Dim startPoint(0 To 2) As Double,endPoint(0 To 2) As Double' Определим начальные и конечные координаты линииstartPoint(0) = 1: startPoint(1) = 1: startPoint(2) = 0 endPoint(0) = 5: endPoint(1) = 5: endPoint(2) = 0 Set lineObj = ThisDrawing.ModelSpace.AddLine (startPoint, endPoint) ZoomExtentsEnd Sub Sub AddLineVB() On Error Resume Next ' Подключениекприложению AutoCAD Dim acadApp As AcadApplication Set acadApp = GetObject (, "AutoCAD.Application") If Err Then Err.Clear Set acadApp = CreateObject ("AutoCAD.Application") If Err Then MsgBox Err.Description Exit Sub End If ' Подключениекрисунку AutoCAD Dim acadDoc As AcadDocument Set acadDoc = acadApp.ActiveDocument Dim lineObj As AcadLine Dim startPoint(0 To 2) As Double Dim endPoint(0 To 2) As Double startPoint(0) = 1: startPoint(1) = 1: startPoint(2) = 0 endPoint(0) = 5: endPoint(1) = 5: endPoint(2) = 0 Set lineObj = acadDoc.ModelSpace.AddLine (startPoint, endPoint)ZoomExtentsEnd SubУправление окружением AutoCAD
Открытие, сохранение и закрытие чертежа
Коллекция Documents и объект Document обеспечивают доступ к файловым функциям. Для этого следует использовать один из методов Add, Close, Save, SaveAs, Import, Export. Примероткрытиярисунка:
Sub OpenDrawing() Dim dwgName As String dwgName = "c:\Program Files\acad2002\sample\campus.dwg" If Dir(dwgName) <> "" Then ThisDrawing.Application.Documents.Open dwgNameElse MsgBox "Файл " & dwgName & " не существует." End IfEnd SubПример создания чертежа:
Sub NewDrawing() Dim docObj As AcadDocument Set docObj = ThisDrawing.Application.Documents.AddEnd SubПример сохранения рисунка:
Sub SaveActiveDrawing() ' Сохранить рисунок с текущим именем ThisDrawing.Save ' А теперь с новым именемThisDrawing.SaveAs "MyDrawing.dwg"End SubПроверка были ли в рисунке какие-то изменения с момента последнего сохранения
Sub TestIfSaved() If Not (ThisDrawing.Saved) Then If MsgBox("Сохранитьизменения?", vbYesNo) = vbYes Then ThisDrawing.SaveEnd IfEnd SubУстановка собственных предпочтений
Доступкобъекту Preferences
Dim acadPref as AcadPreferencesSet acadPref = ThisDrawing.Application.PreferencesПослечегоможнополучитьдоступклюбомуобъекту Preference (предпочтений) пользуясьсвойствами Display, Drafting, Files, OpenSave, Output, Profile, Selection, System, и User properties. Например, сменить размер перекрестия:
acadPref.Display.CursorSize = 100Объект database preferences включает все настройки, которые сохраняются вместе с текущим рисунком.
Управление окном приложения
Пример смены размера и положения окна, минимизация и увеличение до максимума:
Sub PositionApplicationWindow() ThisDrawing.Application.WindowTop = 0 ThisDrawing.Application.WindowLeft = 0 ThisDrawing.Application.width = 400 ThisDrawing.Application.height = 400 ThisDrawing.Application.WindowState = acMax ThisDrawing.Application.WindowState = acMinEnd SubПроверка состояния окна:
Sub CurrentWindowState()Dim CurrWindowState As Integer Dim msg As String CurrWindowState = ThisDrawing.Application.WindowState msg = Choose(CurrWindowState, "normal", "minimized", "maximized") MsgBox "Окноприложения" + msgEnd SubСделатьокноневидимым:
ThisDrawing.Application.Visible = FalseУправление окном рисунка
Аналогично окну приложения можно менять размеры и подчиненного окна - чертежа, как например:
Sub CurrentWindowState() Dim CurrWindowState As Integer Dim msg As String ThisDrawing.Width = 400 ThisDrawing.Height = 400 ThisDrawing.WindowState = acMin ThisDrawing.WindowState = acMax CurrWindowState = ThisDrawing.WindowState msg = Choose(CurrWindowState, "normal", "minimized", "maximized")MsgBox "Окно документа " + msgEnd SubИспользование zoom
Виды - это особые комбинации расположения, масштаба и ориентации рисунка. Команда zoom не меняет размер рисунка, она влияет только на размер его отображения на экране. AutoCAD предлагает несколько путей "зуммирования" по указанному окну, вписать рисунок в окно, указать масштаб вручную. Для "зуммирования" с указанием границ используются методы ZoomWindow или ZoomPickWindow Первый из них позволяет все сделать чисто программно, второй требует ввода границ окна от пользователя. Пример:
Sub ZoomWindow() MsgBox "Увеличение в пределах:" & vbCrLf & "1.3, 7.8, 0" & vbCrLf & "13.7, -2.6, 0" Dim point1(0 To 2) As DoubleDim point2(0 To 2) As Double point1(0) = 1.3: point1(1) = 7.8: point1(2) = 0 point2(0) = 13.7: point2(1) = -2.6: point2(2) = 0 ThisDrawing.Application.ZoomWindow point1, point2 MsgBox "Атеперь ZoomPickWindow" ThisDrawing.Application.ZoomPickWindowEnd SubМасштабирование вида
Если нужно точно указать коэффициент увеличения или уменьшения изображения на экране, то можно воспользоваться тремя способами:
· Относительно границ рисунка
· Относительно текущего вида
· Относительно единиц вычерчивания на листе
При этом следует просто ввести значение. Например, 2 для увеличения в 2 раза и.5 для уменьшения в два раза.
Для масштабирования вида используется метод ZoomScaled, на входе он принимает два параметра масштаб и тип масштаба. Типы масштаба задаются константами: acZoomScaledAbsolute, acZoomScaledRelative, acZoomScaledRelativePSpace.
Sub ZoomScaled() MsgBox "Масштабирование:" & vbCrLf & "Тип: acZoomScaledRelative" & vbCrLf & "Фактор: 2"Dim scalefactor As Double Dim scaletype As Integer scalefactor = 2 scaletype = acZoomScaledRelative ThisDrawing.Application.ZoomScaled scalefactor, scaletypeEnd SubЦентрирование
Указанную точку рисунка можно поместить по центру экрана методом ZoomCenter как в следующем примере:
Sub ZoomCenter() MsgBox "Центрировать:" & vbCrLf & "Центр: 3,3,0" & vbCrLf & "Увеличение: 10"Dim Center(0 To 2) As Double Dim magnification As Double Center(0) = 3: Center(1) = 3: Center(2) = 0: magnification = 10 ThisDrawing.Application.ZoomCenter Center, magnificationEnd SubМеханическое удерживание земляных масс: Механическое удерживание земляных масс на склоне обеспечивают контрфорсными сооружениями различных конструкций...
Папиллярные узоры пальцев рук - маркер спортивных способностей: дерматоглифические признаки формируются на 3-5 месяце беременности, не изменяются в течение жизни...
Наброски и зарисовки растений, плодов, цветов: Освоить конструктивное построение структуры дерева через зарисовки отдельных деревьев, группы деревьев...
История создания датчика движения: Первый прибор для обнаружения движения был изобретен немецким физиком Генрихом Герцем...
© cyberpedia.su 2017-2024 - Не является автором материалов. Исключительное право сохранено за автором текста.
Если вы не хотите, чтобы данный материал был у нас на сайте, перейдите по ссылке: Нарушение авторских прав. Мы поможем в написании вашей работы!