close

Вход

Забыли?

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

?

5.10(1)

код для вставкиСкачать
5.10.2.
'КУБ
'точки A,B,C,D и их координаты
'1 грань
xa = -15: ya = 20: za = -20
xb = -15: yb = 20: zb = 10
xc = 20: yc = 20: zc = 10
xd = 20: yd = 20: zd = -20
'вычисляем нормаль к грани
Call normal(xa, ya, za, xb, yb, zb, xc, yc, zc, xn, yn, zn)
'вычисляем кос угла между источн. света и нормалью к поверх
cus = Abs(cosugolsun(xsun, ysun, zsun, xn, yn, zn))
'интенсивность света
Call MyRGB(modsv(cus))
Call Z_четырехугольник(xa, ya, za, xb, yb, zb, _
xc, yc, zc, xd, yd, zd)
'2
xa = -15: ya = 20: za = 10
xb = -15: yb = 0: zb = 10
xc = 20: yc = 0: zc = 10
xd = 20: yd = 20: zd = 10
Call normal(xa, ya, za, xb, yb, zb, xc, yc, zc, xn, yn, zn)
cus = Abs(cosugolsun(xsun, ysun, zsun, xn, yn, zn))
Call MyRGB(modsv(cus))
Call Z_четырехугольник(xa, ya, za, xb, yb, zb, _
xc, yc, zc, xd, yd, zd)
'3
xa = 20: ya = 20: za = -20
xb = 20: yb = 20: zb = 10
xc = 20: yc = 0: zc = 10
xd = 20: yd = 0: zd = -20
Call normal(xa, ya, za, xb, yb, zb, xc, yc, zc, xn, yn, zn)
cus = Abs(cosugolsun(xsun, ysun, zsun, xn, yn, zn))
Call MyRGB(modsv(cus))
Call Z_четырехугольник(xa, ya, za, xb, yb, zb, _
xc, yc, zc, xd, yd, zd)
Инв.№
подл.
Подпись и дата
Взамен инв.№
Dim kdr(200, 200) As Single
Dim zbufer(200, 200) As Single
Dim RGBcolor As Integer ' цвет грани
Sub Пересечение_фигур_свет()
'Очистка листа от предыдущего рисунка
Worksheets("экран").Range("A1:iv200").Interior.ColorIndex = xlNone
'координаты источника света
xsun = 0
ysun = 30
zsun = 60
'заполнение Z буфера фоновым значением
For i = 1 To 200
For j = 1 To 200
zbufer(i, j) = 1000
Next j
Next i
Лист
Изм. Колич Лист №док.
.
Подп.
Дата
Формат А4
Взамен инв.№
Подпись и дата
Инв.№
подл.
'ФИГУРА №3
'точки A,B,C,D и их координаты
'1 грань
xa = 0: ya = 10: za = -20
xb = 0: yb = 10: zb = 20
xc = 50: yc = 10: zc = 20
xd = 50: yd = 10: zd = -20
Call normal(xa, ya, za, xb, yb, zb, xc, yc, zc, xn, yn, zn)
cus = Abs(cosugolsun(xsun, ysun, zsun, xn, yn, zn))
Call MyRGB(modsv(cus))
Call Z_четырехугольник(xa, ya, za, xb, yb, zb, _
xc, yc, zc, xd, yd, zd)
'2
xa = 0: ya = 10: za = 20
xb = 0: yb = -20: zb = 20
xc = 50: yc = -20: zc = 20
xd = 50: yd = 10: zd = 20
Call normal(xa, ya, za, xb, yb, zb, xc, yc, zc, xn, yn, zn)
cus = Abs(cosugolsun(xsun, ysun, zsun, xn, yn, zn))
Call MyRGB(modsv(cus))
Call Z_четырехугольник(xa, ya, za, xb, yb, zb, _
xc, yc, zc, xd, yd, zd)
'3
xa = 50: ya = 10: za = -20
xb = 50: yb = 10: zb = 20
xc = 50: yc = -20: zc = 20
xd = 50: yd = -20: zd = -20
Call normal(xa, ya, za, xb, yb, zb, xc, yc, zc, xn, yn, zn)
cus = Abs(cosugolsun(xsun, ysun, zsun, xn, yn, zn))
Call MyRGB(modsv(cus))
Call Z_четырехугольник(xa, ya, za, xb, yb, zb, _
xc, yc, zc, xd, yd, zd)
'Треугольник
xa = 30: ya = 10: za = 20
xb = 30: yb = 10: zb = -20
'xc = 52: yc = 0: zc = 20
'xd = 52: yd = 10: zd = 20
Call normal(xa, ya, za, xb, yb, zb, xc, yc, zc, xn, yn, zn)
cus = Abs(cosugolsun(xsun, ysun, zsun, xn, yn, zn))
Call MyRGB(modsv(cus))
Call CAP(131, 76, 120, 88, 131, 96)
Call CAP(121, 106, 120, 88, 131, 96)
cus = Abs(cosugolsun(xsun, ysun, zsun, xn, yn, zn))
Call MyRGB(modsv(cus))
Call CAP(131, 76, 155, 76, 155, 96)
Call CAP(131, 76, 131, 96, 155, 96)
cus = Abs(cosugolsun(xsun, ysun, zsun, xn, yn, zn))
Call MyRGB(modsv(cus))
Call CAP(155, 96, 131, 96, 121, 106)
Call CAP(155, 96, 145, 107, 121, 106)
Call буфер_кадра(50, 170, 50, 170)
Лист
Изм. Колич Лист №док.
.
Подп.
Дата
Формат А4
' Наблюдатель находиться в точке с координатами
Xnabl = 200
Ynabl = 200
Znabl = 0
' грань паралельна плоскости YX
If za = zb And zb = zc And zc = zd Then
' цикл по y
For y = ya To yc Step stepy
' цикл по оси x
For x = xa To xc Step stepx
'
определяем где на экране находиться данная точка
Call XYZ(x, y, za, X_zbyf, Y_zbyf)
'
определяем квадрат расстояние от рассматриваемой точки до наблюдателя
Rnabl = ((Xnabl - x) ^ 2 + (Ynabl - y) ^ 2 + (Znabl - za) ^ 2) ^ 0.5
'
извлекаем данные о значении координаты Y в Z буфере
Zbyf = zbufer(Y_zbyf, X_zbyf)
'
если новое значение ближе к наблюдателю то заменняем значение в
'
z буфере и в буфере кадра
If Rnabl < Zbyf Then
zbufer(Y_zbyf, X_zbyf) = Rnabl
kdr(Y_zbyf, X_zbyf) = RGBcolor
End If
Next x
Next y
End If
'грань паралельна плоскости ZX
If ya = yb And yb = yc And yc = yd Then
For z = za To zc Step stepz
Инв.№
подл.
Подпись и дата
Взамен инв.№
End Sub
Sub Z_четырехугольник(xa, ya, za, xb, yb, zb, _
xc, yc, zc, xd, yd, zd)
'заполняет Z буфер для четырехугольника
'определение направление сканирования четырехугольника
'ось y
If ya > yc Then
stepy = -1
Else
stepy = 1
End If
' ось х
If xa > xc Then
stepx = -1
Else
stepx = 1
End If
' ось z
If za > zc Then
stepz = -1
Else
stepz = 1
End If
Лист
Изм. Колич Лист №док.
.
Подп.
Дата
Формат А4
Взамен инв.№
Подпись и дата
Инв.№
подл.
For x = xa To xc Step stepx
Call XYZ(x, ya, z, X_zbyf, Y_zbyf)
Rnabl = ((Xnabl - x) ^ 2 + (Ynabl - ya) ^ 2 + (Znabl - z) ^ 2) ^ 0.5
Zbyf = zbufer(Y_zbyf, X_zbyf)
If Rnabl < Zbyf Then
zbufer(Y_zbyf, X_zbyf) = Rnabl
kdr(Y_zbyf, X_zbyf) = RGBcolor
End If
Next x
Next z
End If
'грань паралельна плоскости ZY
If xa = xb And xb = xc And xc = xd Then
For y = ya To yc Step stepy
For z = za To zc Step stepz
Call XYZ(xa, y, z, X_zbyf, Y_zbyf)
Rnabl = ((Xnabl - xa) ^ 2 + (Ynabl - y) ^ 2 + (Znabl - z) ^ 2) ^ 0.5
Zbyf = zbufer(Y_zbyf, X_zbyf)
If Rnabl < Zbyf Then
zbufer(Y_zbyf, X_zbyf) = Rnabl
kdr(Y_zbyf, X_zbyf) = RGBcolor
End If
Next z
Next y
End If
End Sub
Sub буфер_кадра(Ymin, Ymax, Xmin, Xmax)
'переносим данные из буфера кадра на экран
For x = Xmin To Xmax
For y = Ymin To Ymax
RGBcolor = kdr(y, x)
Call plott(x, y, RGBcolor)
Next y
Next x
'обнуленеие матриц
For i = 1 To 200
For j = 0 To 200
kdr(i, j) = 0
zbufer(i, j) = 0
Next j
Next i
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, - координаты источника света
Лист
Изм. Колич Лист №док.
.
Подп.
Дата
Формат А4
Взамен инв.№
Подпись и дата
Инв.№
подл.
'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 = 160 * cug
End Function
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
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
Лист
Изм. Колич Лист №док.
.
Подп.
Дата
Формат А4
End If
If ab And bc = True Then
dx = 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)
a11 = 1: a12 = 0: a13 = x0
a21 = 0: a22 = 1: a23 = y0
a31 = 0: a32 = 0: a33 = 1
b11 = x
b21 = y
b31 = 1
xx = a11 * b11 + a12 * b21 + a13 * b31
yy = a21 * b11 + a22 * b21 + a23 * b31
End Sub
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
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
If ab And ac = True Then
dx = 1
If xac < xab Then dx = -1
For xcol = Int(xab) To Int(xac) Step dx
kdr(istr, xcol) = RGBcolor
Next xcol
Лист
Изм. Колич Лист №док.
.
Подп.
Дата
Формат А4
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
kdr(istr, xcol) = RGBcolor
Next xcol
End If
Next istr
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 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 Sub MyRGB(color)
'увеличиваем количество возможных цветов в зависимости от
'интенсивности освещения
If color > 150 Then
RGBcolor = 34
Exit Sub
End If
If color > 140 Then
RGBcolor = 35
Exit Sub
End If
If color > 130 Then
RGBcolor = 33
Инв.№
подл.
Подпись и дата
Взамен инв.№
If xab > xbc Then dx = -1
For xcol = Int(xab) To Int(xbc) Step dx
kdr(istr, xcol) = RGBcolor
Next xcol
Лист
Изм. Колич Лист №док.
.
Подп.
Дата
Формат А4
End Sub
Взамен инв.№
Инв.№
подл.
Подпись и дата
Exit Sub
End If
If color > 120 Then
RGBcolor = 42
Exit Sub
End If
If color > 110 Then
RGBcolor = 41
Exit Sub
End If
If color > 100 Then
RGBcolor = 13
Exit Sub
End If
If color > 90 Then
RGBcolor = 14
Exit Sub
End If
If color > 80 Then
RGBcolor = 10
Exit Sub
End If
If color > 70 Then
RGBcolor = 12
Exit Sub
End If
If color > 60 Then
RGBcolor = 9
Exit Sub
End If
If color > 50 Then
RGBcolor = 53
Exit Sub
End If
If color > 40 Then
RGBcolor = 51
Exit Sub
End If
If color > 30 Then
RGBcolor = 52
Exit Sub
End If
If color > 20 Then
RGBcolor = 56
Exit Sub
End If
RGBcolor = 56
Лист
Изм. Колич Лист №док.
.
Подп.
Дата
Формат А4
Документ
Категория
Математика
Просмотров
16
Размер файла
170 Кб
Теги
1/--страниц
Пожаловаться на содержимое документа