close

Вход

Забыли?

вход по аккаунту

?

5.8 (2)

код для вставкиСкачать
Взамен инв.№
Подпись и дата
Инв.№
подл.
Dim VE(8) As Single
Dim RGBcolor As Integer ' цвет грани
Public Sub поворот_объекта_3()
Dim V(4, 8) As Single
'Очистка листа от предыдущего рисунка
For gamma = 0 To 6.28 Step 0.69776
Range("A1:iv200").Interior.ColorIndex = xlNone
'нижнее основание
xa = -20: ya = -20: za = -20
xb = 20: yb = -20: zb = -20
xc = 20: yc = 10: zc = -20
xd = -20: yd = 10: zd = -20
'сечение
sx1 = 0: sy1 = 10: sz1 = 20
sx2 = 0: sy2 = 0: sz2 = 20
sx3 = 20: sy3 = 0: sz3 = 20
sx4 = 0: sy4 = 10: sz4 = 0
sx5 = 0: sy5 = 0: sz5 = 0
sx6 = 20: sy6 = 0: sz6 = 0
sx7 = 20: sy7 = 10: sz7 = 0
'верхнее
xa1 = -20: ya1 = -20: za1 = 20
xb1 = 20: yb1 = -20: zb1 = 20
xd1 = -20: yd1 = 10: zd1 = 20
'угол наблюдения за кубиком в радианах от иси х
gammaNabl = 0.985
'поворот всех 10 точек
Call поворотZ(gamma, xa, ya, za, xa, ya, za)
Call поворотZ(gamma, xb, yb, zb, xb, yb, zb)
Call поворотZ(gamma, xc, yc, zc, xc, yc, zc)
Call поворотZ(gamma, xd, yd, zd, xd, yd, zd)
Call поворотZ(gamma, xa1, ya1, za1, xa1, ya1, za1)
Call поворотZ(gamma, xb1, yb1, zb1, xb1, yb1, zb1)
Call поворотZ(gamma, xd1, yd1, zd1, xd1, yd1, zd1)
Call поворотZ(gamma, sx1, sy1, sz1, sx1, sy1, sz1)
Call поворотZ(gamma, sx2, sy2, sz2, sx2, sy2, sz2)
Call поворотZ(gamma, sx3, sy3, sz3, sx3, sy3, sz3)
Call поворотZ(gamma, sx4, sy4, sz4, sx4, sy4, sz4)
Call поворотZ(gamma, sx5, sy5, sz5, sx5, sy5, sz5)
Call поворотZ(gamma, sx6, sy6, sz6, sx6, sy6, sz6)
Call поворотZ(gamma, sx7, sy7, sz7, sx7, sy7, sz7)
'матрица тела
V(1, 1) = -2: V(1, 2) = -1: V(1, 3) = 2: V(1, 4) = 0: V(1, 5) = 0: V(1, 6) = 0: V(1, 7) = 0: V(1, 8) = 0
V(2, 1) = 0: V(2, 2) = 0: V(2, 3) = 0: V(2, 4) = 0: V(1, 5) = 0: V(2, 6) = -1: V(1, 7) = -1: V(2, 8) = 2
V(3, 1) = 0: V(3, 2) = 0: V(3, 3) = 0: V(3, 4) = -2: V(1, 5) = -1: V(3, 6) = 0: V(1, 7) = 0: V(3, 8) = 0
Лист
Изм. Колич Лист №док.
.
Подп.
Дата
Формат А4
V(4, 1) = 1: V(4, 2) = 1: V(4, 3) = 1: V(4, 4) = 1: V(1, 5) = 1: V(4, 6) = 1: V(1, 7) = 1: V(4, 8) = 1
'корректируем вектор Е
ex = -Cos(gammaNabl - gamma)
ey = -1: ez = -Sin(gammaNabl - gamma): e1 = 0
VE(1) = ex * V(1, 1) + ey * V(2, 1) + ez * V(3, 1) + e1 * V(4, 1)
VE(2) = ex * V(1, 2) + ye * V(2, 2) + ez * V(3, 2) + e1 * V(4, 2)
VE(3) = ex * V(1, 3) + ey * V(2, 3) + ez * V(3, 3) + e1 * V(4, 3)
VE(4) = ex * V(1, 4) + ey * V(2, 4) + ez * V(3, 4) + e1 * V(4, 4)
VE(5) = ex * V(1, 5) + ey * V(2, 5) + ez * V(3, 5) + e1 * V(4, 5)
VE(6) = ex * V(1, 6) + ey * V(2, 6) + ez * V(3, 6) + e1 * V(4, 6)
VE(7) = ex * V(1, 7) + ey * V(2, 7) + ez * V(3, 7) + e1 * V(4, 7)
VE(8) = ex * V(1, 8) + ey * V(2, 8) + ez * V(3, 8) + e1 * V(4, 8)
'рисуем фигуру
Call Nгранник(xa, ya, za, xb, yb, zb, xc, yc, zc, xd, yd, zd, _
xa1, ya1, za1, xb1, yb1, zb1, xd1, yd1, zd1, sx1, sy1, sz1, sx2, sy2, sz2, sx3, _
sy3, sz3, sx4, sy4, sz4, sx5, sy5, sz5, sx6, sy6, sz6, sx7, sy7, sz7, sx8, sy8, sz8)
Next gamma
End Sub
Sub Nгранник(xa, ya, za, xb, yb, zb, xc, yc, zc, xd, yd, zd, _
xa1, ya1, za1, xb1, yb1, zb1, xd1, yd1, zd1, sx1, sy1, sz1, sx2, sy2, sz2, sx3, _
sy3, sz3, sx4, sy4, sz4, sx5, sy5, sz5, sx6, sy6, sz6, sx7, sy7, sz7, sx8, sy8, sz8)
'проверка на неотрицательность скалярного произведения
'матрицы тела V и вектора наблюдателя Е
If VE(1) > 0 Then
RGBcolor = 3
Call шестиугольникXYZ(xb1, yb1, zb1, sx3, sy3, sz3, _
sx6, sy6, sz6, sx7, sy7, sz7, xc, yc, zc, xb, yb, zb)
End If
If VE(6) > 0 Then
RGBcolor = 5
Call шестиугольникXYZ(xd1, yd1, zd1, sx1, sy1, sz1, sx4, sy4, sz4, _
sx7, sy7, sz7, xc, yc, zc, xd, yd, zd)
End If
'5
If VE(8) < 0 Then
RGBcolor = 16
Call четырехугольникXYZ(sx4, sy4, sz4, sx5, sy5, sz5, sx6, sy6, sz6, _
sx7, sy7, sz7)
End If
'2
If VE(1) > 0 Then
Инв.№
подл.
Подпись и дата
Взамен инв.№
If VE(4) > 0 Then
RGBcolor = 13
Call шестиугольникXYZ(xb1, yb1, zb1, sx3, sy3, sz3, _
sx2, sy2, sz2, sx1, sy1, sz1, xd1, yd1, zd1, xa1, ya1, za1)
End If
Лист
Изм. Колич Лист №док.
.
Подп.
Дата
Формат А4
RGBcolor = 6
Call четырехугольникXYZ(sx4, sy4, sz4, sx1, sy1, sz1, sx2, sy2, sz2, _
sx5, sy5, sz5)
End If
'7
If VE(6) > 0 Then
RGBcolor = 4
Call четырехугольникXYZ(sx5, sy5, sz5, sx2, sy2, sz2, sx3, sy3, sz3, _
sx6, sy6, sz6)
End If
If VE(3) > 0 Then
RGBcolor = 9
Call четырехугольникXYZ(xa1, ya1, za1, xa, ya, za, xd, yd, zd, xd1, yd1, zd1)
End If
End Sub
Sub шестиугольникXYZ(xa, ya, za, xb, yb, zb, _
xc, yc, zc, xd, yd, zd, xe, ye, ze, xf, yf, zf)
'рисует пятиугольник в трехмерном изображении
Call XYZ(xa, ya, za, xxa, yya)
Call XYZ(xb, yb, zb, xxb, yyb)
Call XYZ(xc, yc, zc, xxc, yyc)
Call XYZ(xd, yd, zd, xxd, yyd)
Call XYZ(xe, ye, ze, xxe, yye)
Call XYZ(xf, yf, zf, xxf, yyf)
'закраска
Call шестиугольникXY(xxa, yya, xxb, yyb, xxc, yyc, xxd, yyd, _
xxe, yye, xxf, yyf)
'рисование отрезков
Call граница_шестиугольника(xxa, yya, xxb, yyb, xxc, yyc, xxd, _
yyd, xxe, yye, xxf, yyf)
End Sub
Sub четырехугольникXYZ(xa, ya, za, xb, yb, zb, _
xc, yc, zc, xd, yd, zd)
'рисует четырехугольник в трехмерном изображении
Call XYZ(xa, ya, za, xxa, yya)
Call XYZ(xb, yb, zb, xxb, yyb)
Call XYZ(xc, yc, zc, xxc, yyc)
Call XYZ(xd, yd, zd, xxd, yyd)
'закраска
Call четырехугольникXY(xxa, yya, xxb, yyb, xxc, yyc, xxd, yyd)
'рисование отрезков
Call граница_четырехугольника(xxa, yya, xxb, yyb, xxc, yyc, xxd, yyd)
End Sub
Public Sub XYZ(wx, vy, uz, qX, qY)
'определение угла между осями
Инв.№
подл.
Подпись и дата
Взамен инв.№
If VE(8) > 0 Then
RGBcolor = 19
Call четырехугольникXYZ(xa1, ya1, za1, xa, ya, za, xb, yb, zb, xb1, yb1, zb1)
End If
Лист
Изм. Колич Лист №док.
.
Подп.
Дата
Формат А4
Взамен инв.№
Подпись и дата
Инв.№
подл.
al = 3 * 3.14 / 4
Call поворот(al, 0, 0, vy, 0, qX, qY)
Call сдвиг(100 + wx, 0, qX, qY, qX, qY)
Call сдвиг(0, 100 - uz, qX, qY, qX, qY)
End Sub
Sub поворотZ(ugol, x1, y1, z1, x2, y2, z2)
alpha = ugol
'massiv A
a11 = x1: a21 = y1
a31 = z1: a41 = 1
'massiv B
b11 = Cos(alpha): b12 = -Sin(alpha): b13 = 0: b14 = 0
b21 = Sin(alpha): b22 = Cos(alpha): b23 = 0: b24 = 0
b31 = 0: b32 = 0: b33 = 1: b34 = 0
b41 = 0: b42 = 0: b43 = 0: b44 = 1
'massiv rezultat
x2 = a11 * b11 + a21 * b12 + a31 * b13 + a41 * b14
y2 = a11 * b21 + a21 * b22 + a31 * b23 + a41 * b24
z2 = a11 * b31 + a21 * b32 + a31 * b33 + a41 * b34
End Sub
Public Sub поворот(ugol, x0, y0, x, y, xx, yy)
alpha = ugol
'massiv 2
Dim A(3, 3) As Single
A(1, 1) = 1: A(1, 2) = 0: A(1, 3) = x0
A(2, 1) = 0: A(2, 2) = 1: A(2, 3) = y0
A(3, 1) = 0: A(3, 2) = 0: A(3, 3) = 1
Dim B(3, 3) As Single
B(1, 1) = Cos(alpha): B(1, 2) = -Sin(alpha): B(1, 3) = 0
B(2, 1) = Sin(alpha): B(2, 2) = Cos(alpha): B(2, 3) = 0
B(3, 1) = 0: B(3, 2) = 0: B(3, 3) = 1
'massiv 3
Dim C(3, 3) As Single
C(1, 1) = 1: C(1, 2) = 0: C(1, 3) = -x0
C(2, 1) = 0: C(2, 2) = 1: C(2, 3) = -y0
C(3, 1) = 0: C(3, 2) = 0: C(3, 3) = 1
'massiv 4
Dim E(3, 3) As Single
E(1, 1) = Cos(alpha)
E(1, 2) = -Sin(alpha)
E(1, 3) = (A(1, 1) * B(1, 1) + A(1, 2) * B(2, 1) + A(1, 3) * B(3, 1)) * C(1, 3) + (A(1, 1) * B(1, 2) + A(1, 2)
* B(2, 2) + A(1, 3) * B(3, 2)) * C(2, 3) + (A(1, 1) * B(1, 3) + A(1, 2) * B(2, 3) + A(1, 3) * B(3, 3)) * C(3,
3)
E(2, 1) = Sin(alpha)
E(2, 2) = Cos(alpha)
E(2, 3) = (A(2, 1) * B(1, 1) + A(2, 2) * B(2, 1) + A(2, 3) * B(3, 1)) * C(1, 3) + (A(2, 1) * B(1, 2) + A(2, 2)
* B(2, 2) + A(2, 3) * B(3, 2)) * C(2, 3) + (A(2, 1) * B(1, 3) + A(2, 2) * B(2, 3) + A(2, 3) * B(3, 3)) * C(3,
3)
E(3, 1) = 0
E(3, 2) = 0
E(3, 3) = 1
Dim D(3, 3) As Single
Лист
Изм. Колич Лист №док.
.
Подп.
Дата
Формат А4
Взамен инв.№
Подпись и дата
Инв.№
подл.
al = 3 * 3.14 / 4
Call поворот(al, 0, 0, vy, 0, qX, qY)
Call сдвиг(100 + wx, 0, qX, qY, qX, qY)
Call сдвиг(0, 100 - uz, qX, qY, qX, qY)
End Sub
Sub поворотZ(ugol, x1, y1, z1, x2, y2, z2)
alpha = ugol
'massiv A
a11 = x1: a21 = y1
a31 = z1: a41 = 1
'massiv B
b11 = Cos(alpha): b12 = -Sin(alpha): b13 = 0: b14 = 0
b21 = Sin(alpha): b22 = Cos(alpha): b23 = 0: b24 = 0
b31 = 0: b32 = 0: b33 = 1: b34 = 0
b41 = 0: b42 = 0: b43 = 0: b44 = 1
'massiv rezultat
x2 = a11 * b11 + a21 * b12 + a31 * b13 + a41 * b14
y2 = a11 * b21 + a21 * b22 + a31 * b23 + a41 * b24
z2 = a11 * b31 + a21 * b32 + a31 * b33 + a41 * b34
End Sub
Public Sub поворот(ugol, x0, y0, x, y, xx, yy)
alpha = ugol
'massiv 2
Dim A(3, 3) As Single
A(1, 1) = 1: A(1, 2) = 0: A(1, 3) = x0
A(2, 1) = 0: A(2, 2) = 1: A(2, 3) = y0
A(3, 1) = 0: A(3, 2) = 0: A(3, 3) = 1
Dim B(3, 3) As Single
B(1, 1) = Cos(alpha): B(1, 2) = -Sin(alpha): B(1, 3) = 0
B(2, 1) = Sin(alpha): B(2, 2) = Cos(alpha): B(2, 3) = 0
B(3, 1) = 0: B(3, 2) = 0: B(3, 3) = 1
'massiv 3
Dim C(3, 3) As Single
C(1, 1) = 1: C(1, 2) = 0: C(1, 3) = -x0
C(2, 1) = 0: C(2, 2) = 1: C(2, 3) = -y0
C(3, 1) = 0: C(3, 2) = 0: C(3, 3) = 1
'massiv 4
Dim E(3, 3) As Single
E(1, 1) = Cos(alpha)
E(1, 2) = -Sin(alpha)
E(1, 3) = (A(1, 1) * B(1, 1) + A(1, 2) * B(2, 1) + A(1, 3) * B(3, 1)) * C(1, 3) + (A(1, 1) * B(1, 2) + A(1, 2)
* B(2, 2) + A(1, 3) * B(3, 2)) * C(2, 3) + (A(1, 1) * B(1, 3) + A(1, 2) * B(2, 3) + A(1, 3) * B(3, 3)) * C(3,
3)
E(2, 1) = Sin(alpha)
E(2, 2) = Cos(alpha)
E(2, 3) = (A(2, 1) * B(1, 1) + A(2, 2) * B(2, 1) + A(2, 3) * B(3, 1)) * C(1, 3) + (A(2, 1) * B(1, 2) + A(2, 2)
* B(2, 2) + A(2, 3) * B(3, 2)) * C(2, 3) + (A(2, 1) * B(1, 3) + A(2, 2) * B(2, 3) + A(2, 3) * B(3, 3)) * C(3,
3)
E(3, 1) = 0
E(3, 2) = 0
E(3, 3) = 1
Dim D(3, 3) As Single
Лист
Изм. Колич Лист №док.
.
Подп.
Дата
Формат А4
Взамен инв.№
Подпись и дата
Инв.№
подл.
Call line(x4, y4, x5, y5, 1)
Call line(x5, y5, x6, y6, 1)
Call line(x6, y6, x1, y1, 1)
End Sub
Public Sub граница_четырехугольника(x1, y1, x2, y2, x3, y3, x4, y4)
'рисование границы
Call line(x1, y1, x2, y2, 1)
Call line(x2, y2, x3, y3, 1)
Call line(x3, y3, x4, y4, 1)
Call line(x1, y1, x4, y4, 1)
End Sub
Sub plott(xx, yy, color)
'процедура закраски ячейки
If xx >= 1 And yy >= 1 Then
Worksheets(1).Cells(Int(yy), Int(xx)).Interior.ColorIndex = color
End If
End Sub
Public Function X_Dif_anal(xx1, yy1, xx2, yy2, yanal)
'функция возвращает координату х пересесения отрезка с координатами
'xx1, yy1, xx2, yy2, и сканирующей строки с координатой yanal
k = (xx2 - xx1) / (yy2 - yy1)
X_Dif_anal = xx1 + (yanal - yy1) * k
End Function
Public Function min(w1, w2, w3)
'нахождение минимального значения
If w1 <= w2 And w1 <= w3 Then min = w1
If w2 < w1 And w2 <= w3 Then min = w2
If w3 < w1 And w3 < w2 Then min = w3
End Function
Public Function max(w1, w2, w3)
'нахождение минимального значения
If w1 >= w2 And w1 >= w3 Then max = w1
If w2 > w1 And w2 >= w3 Then max = w2
If w3 > w1 And w3 > w2 Then max = w3
End Function
Public Sub CAP(xa, ya, xb, yb, xc, yc)
'алгоритм закраски методом списка активных ребер
'определение ограничивающего прямоугольника
xmin = min(xa, xb, xc)
ymin = min(ya, yb, yc)
xmax = max(xa, xb, xc)
ymax = max(ya, yb, yc)
'цикл по оси y
For istr = ymin To ymax
'список активных ребер
ab = False
ac = False
bc = False
'сканирующая строка между точками a, b
If (ya - istr) * (yb - istr) <= 0 And ya <> yb Then
ab = True ' ребро активно
'точки пересечения отрезка со строкой istr
Лист
Изм. Колич Лист №док.
.
Подп.
Дата
Формат А4
Инв.№
подл.
Подпись и дата
Взамен инв.№
xab = X_Dif_anal(xa, ya, xb, yb, istr)
End If
'сканирующая строка между точками a, c
If (ya - istr) * (yc - istr) <= 0 And ya <> yc Then
ac = True
xac = X_Dif_anal(xa, ya, xc, yc, istr)
End If
'сканирующая строка между точками b, c
If (yb - istr) * (yc - istr) <= 0 And yc <> yb Then
bc = True
xbc = X_Dif_anal(xb, yb, xc, yc, istr)
End If
'цикл по оси x
'активные ребра ab , ac
If ab And ac = True Then
dx = 1
If xac < xab Then dx = -1
For xcol = Int(xab) To Int(xac) Step dx
Call plott(xcol, istr, RGBcolor)
Next xcol
End If
'активные ребра ab , ac
If ab And bc = True Then
dx = 1
If xab > xbc Then dx = -1
For xcol = Int(xab) To Int(xbc) Step dx
Call plott(xcol, istr, RGBcolor)
Next xcol
End If
If bc And ac = True Then
dx = 1
If xac > xbc Then dx = -1
For xcol = Int(xac) To Int(xbc) Step dx
Call plott(xcol, istr, RGBcolor)
Next xcol
End If
Next istr
End Sub
Лист
Изм. Колич Лист №док.
.
Подп.
Дата
Формат А4
Документ
Категория
Математика
Просмотров
18
Размер файла
152 Кб
Теги
1/--страниц
Пожаловаться на содержимое документа