НОУ ИНТУИТ | Программирование в AutoCAD. Лекция 8: Программирование на VBA

Опубликован: 21.02.2012 | Уровень: специалист | Доступ: свободно

Перемещение объектов

Объекты можно перемещать вдоль вектора без изменения размера и ориентации, а так же вращать вокруг базовой точки. Метод Move требует двух координат, задающих вектор - как далеко и в каком направлении будет движение.

Sub MoveCircle()
  Dim circleObj As AcadCircle
  Dim center(0 To 2) As Double
  Dim radius As Double
  center(0) = 2#: center(1) = 2#: center(2) = 0#: radius = 0.5
  Set circleObj = ThisDrawing.ModelSpace.AddCircle(center, radius)
  ZoomExtents

  ' Определим точки задающие вектор перемещения.
  ' (на 2 единицы вдоль оси X)
  Dim point1(0 To 2) As Double,point2(0 To 2) As Double
  point1(0) = 0: point1(1) = 0: point1(2) = 0
  point2(0) = 2: point2(1) = 0: point2(2) = 0

  circleObj.Move point1, point2
  circleObj.Update
End Sub

Вращение объектов

Метод Rotate требует координаты базовой точки в виде переменной типа Variant, содержащей массив из 3-х координат и угол в радианах - на какой повернуть от текущего положения. Пример вращения полилини относительно базовой точки

Sub RotatePolyline()
  Dim plineObj As AcadLWPolyline
  Dim points(0 To 11) As Double
  points(0) = 1: points(1) = 2: points(2) = 1: points(3) = 3
  points(4) = 2: points(5) = 3: points(6) = 3: points(7) = 3
  points(8) = 4: points(9) = 4: points(10) = 4: points(11) = 2
  Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)
  plineObj.Closed = True
  ZoomExtents

  msgbox "А теперь на 45 градусов"
  ' Зададим угол в 45 градусов и базовую точку (4, 4.25, 0)
  Dim basePoint(0 To 2) As Double
  Dim rotationAngle As Double
  basePoint(0) = 4: basePoint(1) = 4.25: basePoint(2) = 0
  rotationAngle = 0.7853981   ' 45 градусов

  ' Повернем
  plineObj.Rotate basePoint, rotationAngle
  plineObj.Update
  ZoomExtents

End Sub

Удаление объектов

Отдельный объект можно удалить методом Delete. Нельзя удалить только объекты-коллекции ModelSpace, Layers, Dictionaries.

Sub DeletePolyline()
  Dim lwpolyObj As AcadLWPolyline
  Dim vertices(0 To 5) As Double
  vertices(0) = 2: vertices(1) = 4
  vertices(2) = 4: vertices(3) = 2
  vertices(4) = 6: vertices(5) = 4
  Set lwpolyObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(vertices)
  ZoomExtents
  lwpolyObj.Delete
  ThisDrawing.Regen acActiveViewport
End Sub

Масштабирование объектов

Масштабирование объектов возможно указанием базовой точки и длины которые берутся как фактор масштабирования основываясь на текущих единицах измерения. Метод ScaleEntity масштабирует объект пропорционально по всем осям. Он требует укaзания базовой точки и фактора масштабирования. Базовая точка как обычно переменная типа Variant. Фактор масштабирования - величина на которую умножаются размеры объекта. Может быть от нуля до 1 (уменьшение) и больше 1 (увеличение). Пример масштабирования полилинии.

Sub ScalePolyline()
  Dim plineObj As AcadLWPolyline
  Dim points(0 To 11) As Double
  points(0) = 1: points(1) = 2: points(2) = 1: points(3) = 3
  points(4) = 2: points(5) = 3: points(6) = 3: points(7) = 3
  points(8) = 4: points(9) = 4: points(10) = 4: points(11) = 2
  Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)
  plineObj.Closed = True
  ZoomExtents

  ' Зададим масштабирование
  Dim basePoint(0 To 2) As Double
  Dim scalefactor As Double
  basePoint(0) = 4: basePoint(1) = 4.25: basePoint(2) = 0: scalefactor = 0.5
  ' Масштабируем
  plineObj.ScaleEntity basePoint, scalefactor
  plineObj.Update
End Sub

Трансформировние объектов

Конфигурация матрицы трансформации
R00	R01	R02	T0
R10	R11	R12	T1
R20	R21	R22	T2
0	0	0	1

Перед трансформацией объекта следует заполнить матрицу трансформации. В следующем примере объект вращается на 90 градусов вокруг точки (0,0,0) используя матрицу трансформации.

Sub TransformBy()
  Dim lineObj As AcadLine
  Dim startPt(0 To 2) As Double, endPt(0 To 2) As Double
  startPt(0) = 2: startPt(1) = 1
  startPt(2) = 0: endPt(0) = 5
  endPt(1) = 1: endPt(2) = 0
  Set lineObj = ThisDrawing.ModelSpace.AddLine(startPt, endPt)
  ZoomAll

  ' Заполняем матрицу
  Dim transMat(0 To 3, 0 To 3) As Double
  transMat(0, 0) = 0#: transMat(0, 1) = -1#
  transMat(0, 2) = 0#: transMat(0, 3) = 0#
  transMat(1, 0) = 1#: transMat(1, 1) = 0#
  transMat(1, 2) = 0#: transMat(1, 3) = 0#
  transMat(2, 0) = 0#: transMat(2, 1) = 0#
  transMat(2, 2) = 1#: transMat(2, 3) = 0#
  transMat(3, 0) = 0#: transMat(3, 1) = 0#
  transMat(3, 2) = 0#: transMat(3, 3) = 1#

  ' Трансформируем линию
  lineObj.TransformBy transMat
  lineObj.Update
  ZoomExtents
End Sub

Еще ряд примеров матриц трансформации:

1. Вращение на 45 градусов вокруг точки (5,5,0)
0.707107	-0.707107	0.0	5.0
0.707107	0.707107	0.0	-2.071068
0.0	0.0	1.0	0.0
0.0	0.0	0.0	1.0

2. Перемещение в точку (10,10,0)
1.0	0.0	0.0	10.0
0.0	1.0	0.0	10.0
0.0	0.0	1.0	0.0
0.0	0.0	0.0	1.0

3. Масштабирование в 10,10 на точке (0,0,0)
10.0	0.0	0.0	0.0
0.0	10.0	0.0	0.0
0.0	0.0	10.0	0.0
0.0	0.0	0.0	1.0

4. Масштабирование в 10,10 на точке (2,2,0)
10.0	0.0	0.0	-18.0
0.0	10.0	0.0	-18.0
0.0	0.0	10.0	0.0
0.0	0.0	0.0	1.0

Удлинение и подрезка объектов

Можно изменять угол дуги и длину незамкнутых линий, дуг, полилиний, сплайнов и эллиптических дуг. Удлинение и подрезка объектов выполняется изменением их соответствующих свойств. К примеру для удлинения линии просто меняются координаты в свойствах StartPoint и EndPoint, для изменения угла дуги меняются свойства StartAngle и EndAngle. Чтобы отобразить изменения есть метод Update. Пример изменения длины линии

Sub LengthenLine()
  Dim lineObj As AcadLine
  Dim startPoint(0 To 2) As Double,endPoint(0 To 2) As Double
  startPoint(0) = 0: startPoint(1) = 0: startPoint(2) = 0
  endPoint(0) = 1: endPoint(1) = 1: endPoint(2) = 1
  Set lineObj = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
  lineObj.Update

  ' Удлиним линию сменив конечную точку в 4, 4, 4
  endPoint(0) = 4: endPoint(1) = 4: endPoint(2) = 4
  lineObj.endPoint = endPoint
  lineObj.Update
End Sub

Взрывание объектов

Взрывание составных объектов приводит к их конвертации в составляющие компоненты. К примеру, взрывание создает дуги и линии из полилиний, регионов или заменяет блочные ссылки на объекты, из которых состоял блок. Взорванный объект может выглядеть точно так, как и составной, однако цвет и тип линий может и меняться. Метод Explode при взрыве полилинии отбрасывает информацию о ее толщине, полученные линии и дуги проходят по срединной линии бывшей полилинии. Если блок состоял из полилиний, то его приходится взрывать дважды. Блоки, вставленные с неравными масштабами по осям, могут при взрывании создавать непредсказуемые объекты. Нельзя взорвать xref-ссылки. При взрывании блока с атрибутами последние пропадают, однако определения атрибутов остаются. Значения атрибутов и любые модификации теряются. Пример взрыва полилинии

Sub ExplodePolyline()
  Dim plineObj As AcadLWPolyline
  Dim points(0 To 11) As Double
  points(0) = 1: points(1) = 1: points(2) = 1: points(3) = 2
  points(4) = 2: points(5) = 2: points(6) = 3: points(7) = 2
  points(8) = 4: points(9) = 4: points(10) = 4: points(11) = 1

  ' Рисуем полилинию
  Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)

  ' Видоизменяем один из сегментов
  plineObj.SetBulge 3, -0.5
  plineObj.Update
  ZoomExtents
  ' Взрываем
  Dim explodedObjects As Variant
  explodedObjects = plineObj.Explode
  ' Проходим по взорванному объекту, отображая
  ' тип каждого полученного объекта другим цветом
  Dim I As Integer
  For I = 0 To UBound(explodedObjects)
    explodedObjects(I).Color = acRed
    explodedObjects(I).Update
    MsgBox "Тип объекта " & I & ": " & explodedObjects(I).ObjectName
    explodedObjects(I).Color = acByLayer
    explodedObjects(I).Update
  Next
End Sub

Редактирование полилиний

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

Для редактирования полилинии используются следующие свойства и методы:

Closed - замыкает или разрывает полилинию;
Coordinates - задает координаты каждой вершины;
AddVertex - добавляет вершину в LWPolyLine;
SetBulge - задает скос для сегмента по его индексу;
SetWidth - задает ширину в начале и конце сегмента по его индексу.

Пример редактирования полилинии.

Sub EditPolyline()
  Dim plineObj As AcadLWPolyline
  Dim points(0 To 9) As Double
  points(0) = 1: points(1) = 1: points(2) = 1: points(3) = 2
  points(4) = 2: points(5) = 2: points(6) = 3: points(7) = 2
  points(8) = 4: points(9) = 4
  ' Create a light weight Polyline object
  Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)

  ' задать скос для сегмента 3
  plineObj.SetBulge 3, -0.5
  ' задать новую вершину
  Dim newVertex(0 To 1) As Double
  newVertex(0) = 4: newVertex(1) = 1
  plineObj.AddVertex 5, newVertex

  ' задать ширину сегмента 4
  plineObj.SetWidth 4, 0.1, 0.5

  ' замкнуть полилинию
  plineObj.Closed = True
  plineObj.Update
  ZoomExtents
End Sub

Редактирование сплайнов

Для получения более гладких сплайнов можно добавлять дополнительные точки изгиба или менять местоположение существующих. Метод SetFitPoint пригодится в последнем случае. Свойства и методы меняющие характеристик сплайна

Closed - разрывает или замыкает сплайн;
ControlPoints - задает контрольные точки;
EndTangent - задает конечную касательную как направляющий вектор;
FitPoints - задает все точки размещения сплайна;
FitTolerance - переразмещает сплайн по существующим точкам с новым значением Tolerance;
Knots - задает узловые векторы сплайна;
StartTangent - задает начальную касательную сплайна;
AddFitPoint - добавляет точку размещения сплайна с данным индексом;
DeleteFitPoint - удаляет точку размещения сплайна с данным индексом;
ElevateOrder - Elevates the order of the spline to the given order;
GetFitPoint - Читает точку размещения с заданным индексом;
Reverse - Меняет направление сплайна на противоположное;
SetControlPoint - Устанавливает контрольную точку с заданным индексом;
SetFitPoint - Задает одну точку размещения сплайна;
SetWeight - задает вес контрольной точки по индексу
Degree - возвращает степень полинома образующего сплайн;
Area - возвращает площадь замкнутого сплайна;
IsPeriodic - является ли сплайн периодическим;
IsPlanar - лежит ли сплайн в одной плоскости;
IsRational - является ли сплайн рациональным;
NumberOfControlPoints - возвращает число контрольных точек;
NumberOfFitPoints - возвращает число точек размещения.
Пример изменения контрольных точек сплайна

Sub ChangeSplineControlPoint()
  Dim splineObj As AcadSpline
  Dim noOfPoints As Integer
  Dim startTan(0 To 2) As Double
  Dim endTan(0 To 2) As Double
  Dim fitPoints(0 To 8) As Double

  noOfPoints = 3
  startTan(0) = 0.5: startTan(1) = 0.5: startTan(2) = 0
  endTan(0) = 0.5: endTan(1) = 0.5: endTan(2) = 0
  fitPoints(0) = 1: fitPoints(1) = 1: fitPoints(2) = 0
  fitPoints(3) = 5: fitPoints(4) = 5: fitPoints(5) = 0
  fitPoints(6) = 10: fitPoints(7) = 0: fitPoints(8) = 0
  Set splineObj = ThisDrawing.ModelSpace.AddSpline(fitPoints, startTan, endTan)
  splineObj.Update
  ZoomExtents
  ' Изменим координаты первой контрольной точки
  Dim controlPoint(0 To 2) As Double
  controlPoint(0) = 0: controlPoint(1) = 3: controlPoint(2) = 0
  splineObj.SetControlPoint 0, controlPoint
  splineObj.Update
End Sub

Редактирование штриховки

Можно редактировать как границу штриховки так и образец ее заполнения. Если редактируется граница ассоциативной штриховки, образец обновляется только когда заданы допустимые границы. Ассоциативная штриховка обновляется даже если она находится на отключенном слое. Можно редактировать или выбрать новый образец штриховки, однако ассоциативность может быть установлена только при создании штриховки. Свойство AssociativeHatch позволяет проверить является ли штриховка ассоциированной. Чтобы увидеть изменения в штриховке есть метод Evaluate.

Редактирование границ штриховки

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

AppendInnerLoop - добавляет внутреннюю петлю;
AppendOuterLoop - добавляет внешнюю петлю;
InsertLoopAt - вставляет петлю по указанному индексу.

Sub AppendInnerLoopToHatch()
  Dim hatchObj As AcadHatch
  Dim pName As String
  Dim pType As Long
  Dim bAssociativity As Boolean

  ' Определим и создадим штриховку
  pName = "ANSI31"
  pType = 0
  bAssociativity = True
  Set hatchObj = ThisDrawing.ModelSpace.AddHatch(pType, pName, bAssociativity)
  ' Создадим внешнюю петлю
  Dim outLoop(0 To 1) As AcadEntity
  Dim center(0 To 2) As Double
  Dim radius As Double, startAngle As Double, endAngle As Double
  center(0) = 5: center(1) = 3: center(2) = 0: radius = 3
  startAngle = 0: endAngle = 3.141592
  Set outLoop(0) = ThisDrawing.ModelSpace.AddArc(center, radius, startAngle, endAngle)
  Set outLoop(1) = ThisDrawing.ModelSpace.AddLine(outLoop(0).StartPoint,outLoop(0).EndPoint)

  ' Добавим внешнюю петлю к штриховке
  hatchObj.AppendOuterLoop (outLoop)

  ' Создадим внутреннюю петлю
  Dim innerLoop(0) As AcadEntity
  center(0) = 5: center(1) = 4.5: center(2) = 0: radius = 1
  Set innerLoop(0) = ThisDrawing.ModelSpace.AddCircle(center, radius)

  ' Добавм окружность как внутреннюю петлю
  hatchObj.AppendInnerLoop (innerLoop)

  ' Перемситем и отобразим штриховку
  hatchObj.Evaluate
  ThisDrawing.Regen True
End Sub

Дальше >>

Авторизоваться

Программирование в AutoCAD

Программирование на VBA