Информационный портал для профессионалов в области САПР
Вы не вошли. Пожалуйста, войдите или зарегистрируйтесь.
Форумы CADUser → Программирование → VBA → Кто-нибудь делал макрос или функцию VBA - аналог команды align?
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Кто-нибудь делал макрос или функцию VBA, делающий то-же самое, что и команда align?
Использование align в sedcommand довольно сильно замедляет работу при большом числе объектов для выравнивания.
Вроде кто-то писал на форуме, что делал на ObjectArx, а на VBA нет ли?
Спрошу по другому.
Есть треугольник (не прямоугольный), с координатами:
точкаА=0,0,0, т.В=x2,y2,z2 т.С=x3,y3,z3
(длина стороны АВ = d)
Как положить его на плоскость XY, чтобы сторона АВ совместилась с осью Y?
(т.е. чтобы т.В и т.С оказалась на плоскости XY, и т.В оказалась в 0,d,0 )?
> Anatoly
Я думаю, стоит посмотреть в сторону метода
TransformBy, он работает мгновенно
Создать матрицу перемещения и матрицу поворота
и использовать их по-отдельности или
использовать результирующую матрицу как
результат произведения оных
Дело муторное, я пас
~'J'~
> Anatoly
Не ручаюсь за точность, так навскидку:
Sub Test()
Dim ent As AcadEntity
Dim pt
ThisDrawing.Utility.GetEntity ent, pt, vbCrLf & "Select object:"
If TypeOf ent Is AcadLWPolyline Then
Dim pl As AcadLWPolyline
Set pl = ent
Dim fp As Variant
Dim sp As Variant
With pl
fp = .Coordinate(0): sp = .Coordinate(1)
ReDim Preserve fp(2)
fp(2) = 0#
ReDim Preserve sp(2)
sp(2) = 0#
End With
End If
Dim p1 As Variant
p1 = ThisDrawing.Utility.TranslateCoordinates(fp, acWorld, acUCS, 0)
Dim p2 As Variant
p2 = ThisDrawing.Utility.TranslateCoordinates(sp, acWorld, acUCS, 0)
Dim ang As Double
ang = ThisDrawing.Utility.AngleFromXAxis(p1, p2)
ang = 1.5708 - ang
Dim tmx As Variant
tmx = RotateMatrix(p1, ang)
pl.TransformBy (tmx)
fp = pl.Coordinate(0)
ReDim Preserve fp(2)
fp(2) = 0#
Dim orig(2) As Double
orig(0) = 0#: orig(1) = 0#: orig(2) = 0#
tmx = TranslateMatrix(orig, fp)
pl.TransformBy (tmx)
pl.Update
End Sub
Function RotateMatrix(px As Variant, ang As Double) As Variant
Dim tmx(0 To 3, 0 To 3) As Double
tmx(0, 0) = Cos(ang): tmx(0, 1) = -1 * Sin(ang): tmx(0, 2) = 0#: tmx(0, 3) = px(0)
tmx(1, 0) = Sin(ang): tmx(1, 1) = Cos(ang): tmx(1, 2) = 0#: tmx(1, 3) = px(1)
tmx(2, 0) = 0#: tmx(2, 1) = 0#: tmx(2, 2) = 1#: tmx(2, 3) = px(2)
tmx(3, 0) = 0#: tmx(3, 1) = 0#: tmx(3, 2) = 0#: tmx(3, 3) = 1#
RotateMatrix = tmx
End Function
Function TranslateMatrix(ByVal From As Variant, ByVal At As Variant) As Variant
Dim tmx(0 To 3, 0 To 3) As Double
tmx(0, 0) = 1#: tmx(0, 1) = 0#: tmx(0, 2) = 0#: tmx(0, 3) = From(0) - At(0)
tmx(1, 0) = 0#: tmx(1, 1) = 1#: tmx(1, 2) = 0#: tmx(1, 3) = From(1) - At(1)
tmx(2, 0) = 0#: tmx(2, 1) = 0#: tmx(2, 2) = 1#: tmx(2, 3) = From(2) - At(2)
tmx(3, 0) = 0#: tmx(3, 1) = 0#: tmx(3, 2) = 0#: tmx(3, 3) = 1#
TranslateMatrix = tmx
End Function~'J'~
Fatty, спасибо за пример,
Пожалуйста, поясни создание матриц в методе TransformBy.
В Help'e приведен общий вид (R-поворот и T-перемещение):
R00 R01 R02 T0
R10 R11 R12 T1
R20 R21 R22 T2
0 0 0 1
и пример поворота вокруг т. 0,0,0 на 90град:
0.000000 -1.000000 0.000000 0.000000
1.000000 0.000000 0.000000 0.000000
0.000000 0.000000 1.000000 0.000000
0.000000 0.000000 0.000000 1.000000
т.е. поворот вокруг оси Z:
cos90 -sin90 0 0
sin90 cos90 0 0
0 0 1 0
0 0 0 1
В функции RotateMatrix это делается в общем виде:
cosA -sinA 0 p(0)
sinA cosA 0 p(1)
0 0 1 p(2)
0 0 0 1
с другой стороны в Help'e есть пример поворота на 45 град вокруг 5,5,0
0.707107 -0.707107 0.000000 5.000000
0.707107 0.707107 0.000000 -2.071068
0.000000 0.000000 1.000000 0.000000
0.000000 0.000000 0.000000 1.000000
Вопрос: координата -2.071068 откуда взялась?
В литературе по трехмерной графике приводят матрицу вращения вокруг оси Z
cosA sinA 0 0
-sinA cosA 0 0
0 0 1 0
0 0 0 1
у которой знаки синусов противоположны знакам синусов из Help'a VBA,
а вот матрицы вращения вокруг осей X и Y
1 0 0 0
0 cosA sinA 0
0 -sinA cosA 0
0 0 0 1
cosA 0 -sinA 0
0 1 0 0
sinA 0 cosA 0
0 0 0 1
Если есть отличия в разных источниках, то как правильно составить матрицы поворота вокруг осей?
> Anatoly
Я насчет знаков угла поворота в литературе по трехмерной графике
ничего не знаю, в Автокаде углы обычно против часовой
отсюда и знаки
Матрица поворота у меня корявая, делал навскидку,
а сейчас вплотную заняться времени нет
Поищи в Гуглях али еще где
~'J'~
Да, тайна сия великая есть.
Люди уже спрашивали нечто подобное,
и
но ясного ответа нет.
Нашел матрицы поворота вокруг осей Z,X,Y вокруг т. 0,0,0
ent.TransformBy (tmx)
Function RotateMatrixZ(ang As Double) As Variant
Dim tmx(0 To 3, 0 To 3) As Double
tmx(0, 0) = Cos(ang): tmx(0, 1) = -1 * Sin(ang): tmx(0, 2) = 0#: tmx(0, 3) = 0#
tmx(1, 0) = Sin(ang): tmx(1, 1) = Cos(ang): tmx(1, 2) = 0#: tmx(1, 3) = 0#
tmx(2, 0) = 0#: tmx(2, 1) = 0#: tmx(2, 2) = 1#: tmx(2, 3) = 0#
tmx(3, 0) = 0#: tmx(3, 1) = 0#: tmx(3, 2) = 0#: tmx(3, 3) = 1#
RotateMatrixZ = tmx
End Function
Function RotateMatrixX(ang As Double) As Variant
Dim tmx(0 To 3, 0 To 3) As Double
tmx(0, 0) = 1#: tmx(0, 1) = 0#: tmx(0, 2) = 0#: tmx(0, 3) = 0
tmx(1, 0) = 0#: tmx(1, 1) = Cos(ang): tmx(1, 2) = -1 * Sin(ang): tmx(1, 3) = 0
tmx(2, 0) = 0#: tmx(2, 1) = Sin(ang): tmx(2, 2) = Cos(ang): tmx(2, 3) = 0
tmx(3, 0) = 0#: tmx(3, 1) = 0#: tmx(3, 2) = 0#: tmx(3, 3) = 1#
RotateMatrixX = tmx
End Function
Function RotateMatrixY(ang As Double) As Variant
Dim tmx(0 To 3, 0 To 3) As Double
tmx(0, 0) = Cos(ang): tmx(0, 1) = 0#: tmx(0, 2) = -1 * Sin(ang): tmx(0, 3) = 0#
tmx(1, 0) = 0#: tmx(1, 1) = 1#: tmx(1, 2) = 0#: tmx(1, 3) = 0#
tmx(2, 0) = Sin(ang): tmx(2, 1) = 0#: tmx(2, 2) = Cos(ang): tmx(2, 3) = 0#
tmx(3, 0) = 0#: tmx(3, 1) = 0#: tmx(3, 2) = 0#: tmx(3, 3) = 1#
RotateMatrixY = tmx
End Function> Anatoly
Идем дальше
Функция произведения двух матриц:
Function CrossMatrices(tmx1, tmx2) As Variant
' Product of two matrices
Dim mtx(0 To 3, 0 To 3) As Double
Dim m As Integer
Dim n As Integer
Dim c As Integer
Dim tmp As Double
While m < 4
n = 0
While n < 4
c = 0
While c < 4
tmp = tmp + tmx1(c, n) * tmx2(m, c)
c = c + 1
Wend
mtx(m, n) = tmp
tmp = 0
n = n + 1
Wend
m = m + 1
Wend
CrossMatrices = mtx
End Function
'
' Проверка:
' Можно воспользоваться функциями выше для построения
' промежуточных матриц.
' (Здесь просто для наглядности)
Sub TestMultMatrices()
' матрица смещения из точки 5,5,0 в точку 0,0,0
Dim tmx1(0 To 3, 0 To 3) As Double
tmx1(0, 0) = 1#: tmx1(0, 1) = 0#: tmx1(0, 2) = 0#: tmx1(0, 3) = -5#
tmx1(1, 0) = 0#: tmx1(1, 1) = 1#: tmx1(1, 2) = 0#: tmx1(1, 3) = -5#
tmx1(2, 0) = 0#: tmx1(2, 1) = 0#: tmx1(2, 2) = 1#: tmx1(2, 3) = 0#
tmx1(3, 0) = 0#: tmx1(3, 1) = 0#: tmx1(3, 2) = 0#: tmx1(3, 3) = 1#
' матрица поворота на 45 град. вокруг точки 0,0,0
Dim tmx2(0 To 3, 0 To 3) As Double
tmx2(0, 0) = 0.707: tmx2(0, 1) = -0.707: tmx2(0, 2) = 0#: tmx2(0, 3) = 0#
tmx2(1, 0) = 0.707: tmx2(1, 1) = 0.707: tmx2(1, 2) = 0#: tmx2(1, 3) = 0#
tmx2(2, 0) = 0#: tmx2(2, 1) = 0#: tmx2(2, 2) = 1#: tmx2(2, 3) = 0#
tmx2(3, 0) = 0#: tmx2(3, 1) = 0#: tmx2(3, 2) = 0#: tmx2(3, 3) = 1#
' матрица обратного смещения из точки 0,0,0 в точку 5,5,0
Dim tmx3(0 To 3, 0 To 3) As Double
tmx3(0, 0) = 1: tmx3(0, 1) = 0: tmx3(0, 2) = 0#: tmx3(0, 3) = 5#
tmx3(1, 0) = 0: tmx3(1, 1) = 1: tmx3(1, 2) = 0#: tmx3(1, 3) = 5#
tmx3(2, 0) = 0#: tmx3(2, 1) = 0#: tmx3(2, 2) = 1#: tmx3(2, 3) = 0#
tmx3(3, 0) = 0#: tmx3(3, 1) = 0#: tmx3(3, 2) = 0#: tmx3(3, 3) = 1#
Dim matx As Variant
matx = CrossMatrices(CrossMatrices(tmx1, tmx2), tmx3)
Dim q, p
For q = 0 to 3
For p = 0 to 3
Debug.Print matx(q, p)
Next
Next
End Sub~'J~
> Fatty
Спасибо.
Попробовал на результирующей матрице на три движения(поворотZ-поворотY-сдвиг).
Работает!
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Форумы CADUser → Программирование → VBA → Кто-нибудь делал макрос или функцию VBA - аналог команды align?
Форум работает на PunBB, при поддержке Informer Technologies, Inc
