Регулировка привязки и выравнивания сетки

Изменение угла и базовой точки. В данном примере базовая точка устанавливается равной 1,1 и угол наклона сетки 30 градусов:

Sub ChangeSnapBasePoint() ' Включимсетку ThisDrawing.ActiveViewport.GridOn = True ' Сменимбазовуюточку 1,1 Dim newBasePoint(0 To 1) As Double newBasePoint(0) = 1: newBasePoint(1) = 1 ThisDrawing.ActiveViewport.SnapBasePoint = newBasePoint' Сменим угол для привязки на 30 градусов (.575 радиан)Dim rotationAngle As Double rotationAngle = 0.575 ThisDrawing.ActiveViewport.SnapRotationAngle = rotationAngle ' переустановимвидовойэкран ThisDrawing.ActiveViewport = ThisDrawing.ActiveViewportEnd Sub

Включение режима орто (нужен для простой отрисовки перпендикуляров)

ThisDrawing.ActiveViewport.OrthoOn = True

Построение конструкционных линий (в обе стороны бесконечных)

Sub AddXLine() Dim xlineObj As AcadXline Dim basePoint(0 To 2) As Double Dim directionVec(0 To 2) As Double basePoint(0) = 2#: basePoint(1) = 2#: basePoint(2) = 0# directionVec(0) = 1#: directionVec(1) = 1#: directionVec(2) = 0# Set xlineObj = ThisDrawing.ModelSpace.AddXLine (basePoint, directionVec) ThisDrawing.Application.ZoomAllEnd Sub

Опросконструкционныхлиний

В примере ищется базовая точка и направляющий вектор:

Dim BPoint As VariantDim Vector As VariantSet BPoint = xlineObj.basePointSet Vector = xlineObj.DirectionVector

Создание, опрос и редактирование лучей

Sub EditRay()Dim rayObj As AcadRay Dim basePoint(0 To 2) As Double,secondPoint(0 To 2) As Double ' Определимлуч basePoint(0) = 3#: basePoint(1) = 3#: basePoint(2) = 0# secondPoint(0) = 4#: secondPoint(1) = 4#: secondPoint(2) = 0# ' Создадимлучвпространствемодели Set rayObj = ThisDrawing.ModelSpace.AddRay (basePoint, secondPoint) ThisDrawing.Application.ZoomAll ' Получимсостояниелуча MsgBox "Базоваяточкалуча: " & rayObj.basePoint(0) & ", " & _ rayObj.basePoint(1) & ", " & rayObj.basePoint(2) & vbCrLf & _"Направляющий вектор луча: " & rayObj.DirectionVector(0) & ", " & _ rayObj.DirectionVector(1) & ", " & rayObj.DirectionVector(2) ' Изменим направляющий вектор лучаDim newVector(0 To 2) As Double newVector(0) = -1: newVector(1) = 1: newVector(2) = 0 rayObj.DirectionVector = newVector ThisDrawing.Regen False MsgBox "Базоваяточкалуча: " & rayObj.basePoint(0) & ", " & _ rayObj.basePoint(1) & ", " & rayObj.basePoint(2) & vbCrLf & _"Направляющий вектор луча: " & rayObj.DirectionVector(0) & ", " & _rayObj.DirectionVector(1) & ", " & rayObj.DirectionVector(2)End Sub

Вычисления с использованием выражений

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

· Найти угол линии от оси X методом AngleFromXAxis

· Преобразовать угол из строки в вещественное (двойной точности) методом AngleToReal

· Преобразовать угол из вещественного (двойной точности) в строку методом AngleToString

· Преобразовать расстояние из строки в вещественное (двойной точности) методом DistanceToReal

· Создать переменную типа Variant, содержащую массив целых, с плавающей точкой двойной точности и т.д. методом CreateTypedArray

· Найти точку отложенную на заданном расстоянии и под заданным углом методом PolarPoint

· Перевести точку в другую систему координат методом TranslateCoordinates

· Найти расстояние между двумя точками методом GetDistance

Sub GetDistanceBetweenTwoPoints() Dim returnDist As Double returnDist = ThisDrawing.Utility.GetDistance (, "Выбери 2 точки.")MsgBox "Расстояние между точками: " & returnDistEnd Sub

Подсчет площадей

Используя значение свойства Area, определим площадь многоугольника, вершины которого указаны пользователем:

Sub CalculateDefinedArea() Dim p1 As Variant,p2 As Variant,p3 As Variant,p4 As Variant,p5 As Variant' Получить точки от пользователя p1 = ThisDrawing.Utility.GetPoint(, vbCrLf & "1-ая точка: ")p2 = ThisDrawing.Utility.GetPoint(p1, vbCrLf & "2-аяточка: ") p3 = ThisDrawing.Utility.GetPoint(p2, vbCrLf & "3-аяточка: ") p4 = ThisDrawing.Utility.GetPoint(p3, vbCrLf & "4-аяточка: ") p5 = ThisDrawing.Utility.GetPoint(p4, vbCrLf & "5-аяточка: ") ' Создаемдвумернуюполилинию Dim polyObj As AcadLWPolyline Dim vertices(0 To 9) As Double vertices(0) = p1(0): vertices(1) = p1(1) vertices(2) = p2(0): vertices(3) = p2(1) vertices(4) = p3(0): vertices(5) = p3(1) vertices(6) = p4(0): vertices(7) = p4(1) vertices(8) = p5(0): vertices(9) = p5(1) Set polyObj = ThisDrawing.ModelSpace.AddLightWeightPolyline (vertices) polyObj.Closed = True ThisDrawing.Application.ZoomAllMsgBox "Площадь определенная точками " & polyObj.AreaEnd Sub