Определение пользовательской системы координат

Часто бывает нужно сменить положение начальной точки отсчета системы координат и ориентацию осей, особенно при работе с трехмерными моделями. При этом системы координат пространства листа ограничены плоскостью. Метод Add, позволяющий создать новую систему координат требует на входе четыре параметра: координаты начала, координаты осей X Y и название ПСК. (пользоавтельской системы координат). Все координаты вводятся в мировой системе. Метод GetUCSMatrix используется для преобразования систем координат. Чтобы сделать систему координат активной используется свойство объекта Document.ActiveUCS. Если изменения делаются в активной системе координат, то требуется повторная установка свойства ActiveUCS. Пример создания системы координат, установки ее активной и трансляции координат точек в новую систему координат.

Sub NewUCS() Dim ucsObj As AcadUCS Dim origin(0 To 2) As Double Dim xAxisPnt(0 To 2) As Double Dim yAxisPnt(0 To 2) As Double ' ЗададимточкиПСК origin(0) = 4: origin(1) = 5: origin(2) = 3 xAxisPnt(0) = 5: xAxisPnt(1) = 5: xAxisPnt(2) = 3yAxisPnt(0) = 4: yAxisPnt(1) = 6: yAxisPnt(2) = 3 ' Добавим в ПСК в коллекцию UserCoordinatesSystems Set ucsObj = ThisDrawing.UserCoordinateSystems. _      Add(origin, xAxisPnt, yAxisPnt, "New_UCS") ' ОтобразимзначекПСК ThisDrawing.ActiveViewport.UCSIconAtOrigin = True ThisDrawing.ActiveViewport.UCSIconOn = True ' Сделаемактивной ThisDrawing.ActiveUCS = ucsObj MsgBox "ТекущаяПСК: " & ThisDrawing.ActiveUCS.Name & vbCrLf & " Выбериточку." ' Найти ПСК и МСК - координаты точкиDim WCSPnt As Variant,UCSPnt As Variant WCSPnt = ThisDrawing.Utility.GetPoint(, "Введиточку: ") UCSPnt = ThisDrawing.Utility.TranslateCoordinates(WCSPnt, acWorld, acUCS, False) MsgBox "Коорд. МСК: " & WCSPnt(0) & ", " & WCSPnt(1) & ", " & WCSPnt(2) & vbCrLf & _   "Коорд. ПСК: " & UCSPnt(0) & ", " & UCSPnt(1) & ", " & UCSPnt(2)End Sub

Преобразования координат

Метод TranslateCoordinates преобразует координаты точек из одной системы в другую. Параметр OriginalPoint может рассматриваться как 3D точка так и 3D вектор. Этот аргумент различается в зависимости от значения аргумента Disp, если последний равен TRUE, значит OriginalPoint рассматривается как вектор. Еще два аргумента определяют из какой системы в какую преобразовывать. В качестве их значений могут быть WCS - мировая система (все остальные задаются относительно нее), UCS - рабочая система (все координаты задаются относительно нее), OCS - система координат объекта, DCS - система координат дисплея, PSDCS - система координат пространства листа. Примерпреобразования OCS в WCS

Sub TranslateCoordinates() Dim plineObj As AcadPolyline Dim points(0 To 14) As Double points(0) = 1: points(1) = 1: points(2) = 0 points(3) = 1: points(4) = 2: points(5) = 0 points(6) = 2: points(7) = 2: points(8) = 0 points(9) = 3: points(10) = 2: points(11) = 0 points(12) = 4: points(13) = 4: points(14) = 0 Set plineObj = ThisDrawing.ModelSpace.AddPolyline(points) ' Найдем X и Y координаты первой вершины полилинииDim firstVertex As Variant firstVertex = plineObj.Coordinate(0) ' Найдем Z-координату полилинии, через свойство elevationfirstVertex(2) = plineObj.Elevation Dim plineNormal(0 To 2) As Double plineNormal(0) = 0#: plineNormal(1) = 1#: plineNormal(2) = 2# plineObj.Normal = plineNormal ' Переведем из OCS в WCSDim coordinateWCS As Variant coordinateWCS = ThisDrawing.Utility.TranslateCoordinates _   (firstVertex, acOCS, acWorld, False, plineNormal) MsgBox "Координаты первой вершины полилинии:" _& vbCrLf & "OCS: " & firstVertex(0) & ", " & _    firstVertex(1) & ", " & firstVertex(2) & vbCrLf & _    "WCS: " & coordinateWCS(0) & ", " & _    coordinateWCS(1) & ", " & coordinateWCS(2)End Sub

Создание 3-мерных объектов

AutoCAD поддерживает три типа трехмерных объектов: каркасная рамка, поверхность и сплошной, каждый из типов обладает своими методами создания и редактирования. Каркасная рамка представляет собой скелетное описание трехмерного объекта и состоит только из точек, линий, кривых, описывающих грани объекта. Второй тип более сложен, т.к. описывает еще и поверхность, а третий наиболее простой способ рисования реальных объектов. При этом используется базовый набор - куб, конус, цилиндр, сфера, клин и тор. Сложные объекты можно получить путем объединения, вычитания и пересечения. Еще способ получить трехмерный объект заключается во вращении плоского вокруг оси.

Создание каркасных рамок

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

Создание сеток

Сетки можно создавать как в 2D так и в 3D, но используются они приимущественно в трехмерных построениях. Нужны в тех случаях когда нет необходимости детального просмотра объекта, бывают разомкнутыми и замкнутыми. Создаются с использованием метода Add3DMesh, который на входе требует три параметра: Число вершин в направлении M, число вершин в направлении N, и массив типа Variant с координатами всех вершин. Как только создана PolygonMesh через свойства MClose и NClose можно делать сетку замкнутой. Примерсозданиясетки 4х4

Sub Create3DMesh() Dim meshObj As AcadPolygonMesh Dim mSize, nSize, Count As Integer Dim points(0 To 47) As Double ' координатывершинсетки points(0) = 0: points(1) = 0: points(2) = 0 points(3) = 2: points(4) = 0: points(5) = 1 points(6) = 4: points(7) = 0: points(8) = 0 points(9) = 6: points(10) = 0: points(11) = 1 points(12) = 0: points(13) = 2: points(14) = 0 points(15) = 2: points(16) = 2: points(17) = 1 points(18) = 4: points(19) = 2: points(20) = 0 points(21) = 6: points(22) = 2: points(23) = 1 points(24) = 0: points(25) = 4: points(26) = 0 points(27) = 2: points(28) = 4: points(29) = 1 points(30) = 4: points(31) = 4: points(32) = 0 points(33) = 6: points(34) = 4: points(35) = 0 points(36) = 0: points(37) = 6: points(38) = 0 points(39) = 2: points(40) = 6: points(41) = 1 points(42) = 4: points(43) = 6: points(44) = 0 points(45) = 6: points(46) = 6: points(47) = 0 mSize = 4: nSize = 4 Set meshObj = ThisDrawing.ModelSpace.Add3DMesh(mSize, nSize, points) ' Изменим направление взгляда, чтоб лучше видетьDim NewDirection(0 To 2) As Double NewDirection(0) = -1: NewDirection(1) = -1: NewDirection(2) = 1 ThisDrawing.ActiveViewport.direction = NewDirection ThisDrawing.ActiveViewport = ThisDrawing.ActiveViewport ZoomAllEnd Sub

Создание polyface сетки

Используя метод AddPolyfaceMesh можно создавать сетку каждая грань которой может состоять из нескольких вершин. Каждой грани можно назначить свой цвет или сделать ее невидимой, если задать отрицательное значение номеров вершин. Примерсоздания:

Sub CreatePolyfaceMesh() Dim vertex(0 To 17) As Double vertex(0) = 4: vertex(1) = 7: vertex(2) = 0 vertex(3) = 5: vertex(4) = 7: vertex(5) = 0 vertex(6) = 6: vertex(7) = 7: vertex(8) = 0 vertex(9) = 4: vertex(10) = 6: vertex(11) = 0 vertex(12) = 5: vertex(13) = 6: vertex(14) = 0 vertex(15) = 6: vertex(16) = 6: vertex(17) = 1 Dim FaceList(0 To 7) As Integer FaceList(0) = 1: FaceList(1) = 2 FaceList(2) = 5: FaceList(3) = 4 FaceList(4) = 2: FaceList(5) = 3 FaceList(6) = 6: FaceList(7) = 5 Dim polyfaceMeshObj As AcadPolyfaceMesh Set polyfaceMeshObj = ThisDrawing.ModelSpace.AddPolyfaceMesh(vertex, FaceList)' Чтоб лучше было видно сменим обзорDim NewDirection(0 To 2) As Double NewDirection(0) = -1: NewDirection(1) = -1: NewDirection(2) = 1 ThisDrawing.ActiveViewport.direction = NewDirection ThisDrawing.ActiveViewport = ThisDrawing.ActiveViewportZoomAllEnd Sub