close

Вход

Забыли?

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

?

5.11prog

код для вставкиСкачать
Dim VE(1, 7) As Double
Dim v(4, 7) As Double
Dim E(1, 4) As Double
Dim RGBcolor As Integer ' цвет грани
Dim Igr(7) As Variant 'массив освещенности граней
'координаты источника света
Dim xsun As Variant
Dim ysun As Variant
Dim zsun As Variant
Public Sub Гуро_объект_3()
'координаты источника
xsun = 20
ysun = 0
zsun = 60
'матрица тела
v(1, 1) = -2: v(1, 2) = 2: v(1, 3) = 0: v(1, 4) = 0: v(1, 5) = 0: v(1, 6) = 0: v(1, 7) = 0
v(2, 1) = 0: v(2, 2) = 0: v(2, 3) = -2: v(2, 4) = 2: v(2, 5) = 0: v(2, 6) = 0: v(2, 7) = -2
v(3, 1) = 0: v(3, 2) = 0: v(3, 3) = 0: v(3, 4) = 0: v(3, 5) = -2: v(3, 6) = 2: v(3, 7) = 1
v(4, 1) = 1: v(4, 2) = 1: v(4, 3) = 1: v(4, 4) = 1: v(4, 5) = 1: v(4, 6) = 1: v(4, 7) = -40
gamma = 3.14 / 2
'Координаты нижнего основания
xa = -20: ya = -20: za = -20
xb = 20: yb = -20: zb = -20
xc = 20: yc = 10: zc = -20
xd = -20: yd = 10: zd = -20
'Координаты верхнего основания
xa1 = -20: ya1 = -10: za1 = 20
xb1 = 20: yb1 = -10: zb1 = 20
xc1 = 20: yc1 = 10: zc1 = 20
xd1 = -20: yd1 = 10: zd1 = 20
'Координаты сечения
xe = -20: ye = -20: ze = 0
xf = 20: yf = -20: zf = 0
'угол наблюдения в радианах от иси х
gammaNabl = 0.985
'корректируем вектор Е
E(1, 1) = -Cos(gammaNabl - gamma): E(1, 2) = -1: E(1, 3) = -Sin(gammaNabl - gamma): E(1, 4)
=0
'поворот всех точек
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, xc1, yc1, zc1, xc1, yc1, zc1)
Call поворотZ(gamma, xd1, yd1, zd1, xd1, yd1, zd1)
Лист
Изм Лист №
.
докум.
Подп. Дата
Call поворотZ(gamma, xe, ye, ze, xe, ye, ze)
Call поворотZ(gamma, xf, yf, zf, xf, yf, zf)
Call mul(1, 4, 4, 7, E, v, VE)
'рисуем фигуру
Call Nгранник(xa, ya, za, xb, yb, zb, xc, yc, zc, xd, yd, zd, _
xa1, ya1, za1, xb1, yb1, zb1, xc1, yc1, zc1, xd1, yd1, zd1, _
xe, ye, ze, xf, yf, zf)
End Sub
Sub Nгранник(xa, ya, za, xb, yb, zb, xc, yc, zc, xd, yd, zd, _
xa1, ya1, za1, xb1, yb1, zb1, xc1, yc1, zc1, _
xd1, yd1, zd1, xe, ye, ze, xf, yf, zf)
'проверка на неотрицательность скалярного произведения
'матрицы тела V и вектора наблюдателя Е
If VE(1, 1) > 0 Then
'вычисляем нормаль к грани
Call normal(xb1, yb1, zb1, xf, yf, zf, xb, yb, zb, xn, yn, zn)
'вычисляем кос угла между источн. света и нормалью к поверх
cus = Abs(cosugolsun(xsun, ysun, zsun, xn, yn, zn))
'интенсивность света
Igr(1) = modsv(cus)
Call пятиугольникXYZ(xb1, yb1, zb1, xf, yf, zf, xb, yb, zb, xc, yc, zc, xc1, yc1, zc1, 1)
End If
If VE(1, 2) > 0 Then
'вычисляем нормаль к грани
Call normal(xa, ya, za, xe, ye, ze, xa1, ya1, za1, xn, yn, zn)
'вычисляем кос угла между источн. света и нормалью к поверх
cus = Abs(cosugolsun(xsun, ysun, zsun, xn, yn, zn))
'интенсивность света
Igr(2) = modsv(cus)
Call пятиугольникXYZ(xa, ya, za, xe, ye, ze, xa1, ya1, za1, xd1, yd1, zd1, xd, yd, zd, 2)
End If
If VE(1, 3) > 0 Then
'вычисляем нормаль к грани
Call normal(xa1, ya1, za1, xb1, yb1, zb1, xc1, yc1, zc1, xn, yn, zn)
'вычисляем кос угла между источн. света и нормалью к поверх
cus = Abs(cosugolsun(xsun, ysun, zsun, xn, yn, zn))
'интенсивность света
Igr(3) = modsv(cus)
Call четырехугольникXYZ(xa1, ya1, za1, xb1, yb1, zb1, xc1, yc1, zc1, xd1, yd1, zd1, 3)
End If
If VE(1, 4) > 0 Then
'вычисляем нормаль к грани
Call normal(xa, ya, za, xb, yb, zb, xc, yc, zc, xn, yn, zn)
'вычисляем кос угла между источн. света и нормалью к поверх
cus = Abs(cosugolsun(xsun, ysun, zsun, xn, yn, zn))
'интенсивность света
Лист
Изм Лист №
.
докум.
Подп. Дата
Igr(4) = modsv(cus)
Call четырехугольникXYZ(xa, ya, za, xb, yb, zb, xc, yc, zc, xd, yd, zd, 4)
End If
If VE(1, 5) > 0 Then
'вычисляем нормаль к грани
Call normal(xc1, yc1, zc1, xc, yc, zc, xd, yd, zd, xn, yn, zn)
'вычисляем кос угла между источн. света и нормалью к поверх
cus = Abs(cosugolsun(xsun, ysun, zsun, xn, yn, zn))
'интенсивность света
Igr(5) = modsv(cus)
Call четырехугольникXYZ(xc1, yc1, zc1, xc, yc, zc, xd, yd, zd, xd1, yd1, zd1, 5)
End If
If VE(1, 6) > 0 Then
'вычисляем нормаль к грани
Call normal(xa, ya, za, xe, ye, ze, xf, yf, zf, xn, yn, zn)
'вычисляем кос угла между источн. света и нормалью к поверх
cus = Abs(cosugolsun(xsun, ysun, zsun, xn, yn, zn))
'интенсивность света
Igr(6) = modsv(cus)
Call четырехугольникXYZ(xa, ya, za, xe, ye, ze, xf, yf, zf, xb, yb, zb, 6)
End If
If VE(1, 6) > 0 Then
'вычисляем нормаль к грани
Call normal(xe, ye, ze, xa1, ya1, za1, xb1, yb1, zb1, xn, yn, zn)
'вычисляем кос угла между источн. света и нормалью к поверх
cus = Abs(cosugolsun(xsun, ysun, zsun, xn, yn, zn))
'интенсивность света
Igr(7) = modsv(cus)
Call четырехугольникXYZ(xe, ye, ze, xa1, ya1, za1, xb1, yb1, zb1, xf, yf, zf, 7)
End If
End Sub
Sub четырехугольникXYZ(xa, ya, za, xb, yb, zb, _
xc, yc, zc, xd, yd, zd, ngr)
'рисует четырехугольник в трехмерном изображении
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, ngr)
'рисование отрезков
'Call граница_четырехугольника(xxa, yya, xxb, yyb, xxc, yyc, xxd, yyd)
End Sub
Public Sub четырехугольникXY(x1, y1, x2, y2, x3, y3, x4, y4, ngr)
'закраска четырехугольника как двух треугольников
Call treug_Guro(x1, y1, x2, y2, x3, y3, ngr)
Call treug_Guro(x1, y1, x3, y3, x4, y4, ngr)
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 пятиугольникXYZ(xa, ya, za, xb, yb, zb, _
xc, yc, zc, xd, yd, zd, xe, ye, ze, ngr)
'рисует пятиугольник в трехмерном изображении
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 пятиугольникXY(xxa, yya, xxb, yyb, xxc, yyc, xxd, yyd, _
xxe, yye, ngr)
'рисование отрезков
'Call граница_пятиугольника(xxa, yya, xxb, yyb, xxc, yyc, xxd, _
yyd, xxe, yye)
End Sub
Public Sub пятиугольникXY(x1, y1, x2, y2, x3, y3, x4, y4, x5, y5, ngr)
'закраска пятиугольника как трех треугольников
Call treug_Guro(x1, y1, x2, y2, x3, y3, ngr)
Call treug_Guro(x1, y1, x3, y3, x4, y4, ngr)
Call treug_Guro(x1, y1, x4, y4, x5, y5, ngr)
End Sub
Public Sub граница_пятиугольника(x1, y1, x2, y2, x3, y3, x4, y4, x5, y5)
'рисование границы
Call line(x1, y1, x2, y2, 1)
Call line(x2, y2, x3, y3, 1)
Call line(x3, y3, x4, y4, 1)
Call line(x4, y4, x5, y5, 1)
Call line(x5, y5, x1, y1, 1)
End Sub
Public Sub XYZ(wx, vy, uz, qX, qY)
'определение угла между осями
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
D(1, 1) = x
D(2, 1) = y
D(3, 1) = 1
xx = E(1, 1) * D(1, 1) + E(1, 2) * D(2, 1) + E(1, 3) * D(3, 1)
yy = E(2, 1) * D(1, 1) + E(2, 2) * D(2, 1) + E(2, 3) * D(3, 1)
End Sub
Sub сдвиг(x0, y0, x, y, xx, yy)
'massiv A
a11 = 1: a12 = 0: a13 = x0
a21 = 0: a22 = 1: a23 = y0
a31 = 0: a32 = 0: a33 = 1
'massiv B
b11 = x
b21 = y
Лист
Изм Лист №
.
докум.
Подп. Дата
b31 = 1
'massiv rezultat
xx = a11 * b11 + a12 * b21 + a13 * b31
yy = a21 * b11 + a22 * b21 + a23 * b31
End Sub
Sub line(x1, y1, x2, y2, color)
If Abs(x2 - x1) >= Abs(y2 - y1) Then
dlina = Abs(x2 - x1)
Else
dlina = Abs(y2 - y1)
End If
dx = (x2 - x1) / dlina
dy = (y2 - y1) / dlina
i = 0: xr = x1: yr = y1
Do While i <= dlina
Call plott(xr, yr, color)
xr = xr + dx
yr = yr + dy
i=i+1
Loop
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
Sub mul(n1, m1, n2, m2, a, b, c)
'функция скалярного произведения двух матриц
For k = 1 To n1
For i = 1 To m2
Лист
Изм Лист №
.
докум.
Подп. Дата
tmp = 0
For j = 1 To m1
tmp = tmp + a(k, j) * b(j, i)
Next j
c(k, i) = tmp
Next i
Next k
End Sub
Public Function modGuro(x, x1, x2, n)
'Вычисление освещенности граней методом Гуро
'освещенность на соседних ребрах
'Проверка краиних индексов массивов
If n = 7 Then
I1 = Igr(0)
Else
I1 = Igr(n + 1)
End If
'Левое ребро
Il = (I1 + Igr(n)) / 2
If n = 0 Then
I2 = Igr(7)
Else
I2 = Igr(n - 1)
End If
'Правое ребро
Ir = (I2 + Igr(n)) / 2
'Освещенность в текущей точке x
If x2 = x1 Then
modGuro = (Ir + Il) / 2
Else
modGuro = Il - (Il - Ir) * (x - x2) / (x1 - x2)
'Stop
End If
End Function
Public Sub treug_Guro(xa, ya, xb, yb, xc, yc, ngr)
'алгоритм закраски методом списка активных ребер
'определение ограничивающего прямоугольника
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 Step 1
'список активных ребер
ab = False
ac = False
bc = False
'сканирующая строка между точками a, b
Лист
Изм Лист №
.
докум.
Подп. Дата
If (ya - istr) * (yb - istr) <= 0 And ya <> yb Then
ab = True ' ребро активно
'точки пересечения отрезка со строкой istr
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
'Функция определения интенсивности освещения по модели Гуро
RGBcolor = modGuro(Int(xcol), Int(xab), Int(xac), ngr)
Call plott_color(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
'Функция определения интенсивности освещения по модели Гуро
RGBcolor = modGuro(Int(xcol), Int(xab), Int(xbc), ngr)
Call plott_color(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
'Функция определения интенсивности освещения по модели Гуро
RGBcolor = modGuro(Int(xcol), Int(xbc), Int(xac), ngr)
Call plott_color(xcol, istr, RGBcolor)
Next xcol
End If
Next istr
End Sub
Лист
Изм Лист №
.
докум.
Подп. Дата
Public Sub plott_color(xx, yy, intens)
'функция рисования путем создания прямоугольника
Worksheets("Лист1").Shapes.AddShape(msoShapeRectangle, 2 * xx, 2 * yy, 2, 2).Select
' закраска прямоугольника
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(intens, intens, intens)
'удаление границы
Selection.ShapeRange.line.Visible = msoFalse
End Sub
Sub normal(xxa, yya, zza, xxb, yyb, zzb, xxc, yyc, zzc, xxn, yyn, zzn)
'процедура вычисления нормали к поверхности
'входные величины координаты трех точек в мировых координатах
'xxn, yyn, zzn координаты радиус-вектора к нормале
xxn = (yyb - yya) * (zzc - zza) - (zzb - zza) * (yyc - yya)
yyn = (zzb - zza) * (xxc - xxa) - (xxb - xxa) * (zzc - zza)
zzn = (xxb - xxa) * (yyc - yya) - (yyb - yya) * (xxc - xxa)
End Sub
Function cosugolsun(xxsun, yysun, zzsun, xxn, yyn, zzn)
'xxsun, yysun, zzsun, - координаты источника света
'xxn, yyn, zzn - координаты нормали к поверхности
'вычислим длину радиус векторов
sun = (xxsun ^ 2 + yysun ^ 2 + zzsun ^ 2) ^ 0.5
n = (xxn ^ 2 + yyn ^ 2 + zzn ^ 2) ^ 0.5
'косинус угла между источником света и норалью к поверхности
cosugolsun = (xxsun * xxn + yysun * yyn + zzsun * zzn) / (sun * n)
End Function
Function modsv(cug)
'модель освещения матового тела
modsv = 255 * cug
End Function
Лист
Изм Лист №
.
докум.
Подп. Дата
Документ
Категория
Математика
Просмотров
12
Размер файла
161 Кб
Теги
11prog
1/--страниц
Пожаловаться на содержимое документа