close

Вход

Забыли?

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

?

5.9(1)

код для вставкиСкачать
Взамен инв.№
Подпись и дата
Инв.№
подл.
Dim kdr(200, 200) As Single
Dim zbufer(200, 200) As Single
Dim RGBcolor As Integer ' цвет грани
Sub Пересечение_фигур()
'Очистка листа от предыдущего рисунка
Worksheets("экран").Range("A1:iv200").Interior.ColorIndex = xlNone
'заполнение Z буфера фоновым значением
For i = 1 To 200
For j = 1 To 200
zbufer(i, j) = 1000
Next j
Next i
'КУБ
'точки A,B,C,D и их координаты
xa = -15: ya = 20: za = -20
xb = -15: yb = 20: zb = 10
xc = 20: yc = 20: zc = 10
xd = 20: yd = 20: zd = -20
'отбражение точек на экране
RGBcolor = 11
Call Z_четырехугольник(xa, ya, za, xb, yb, zb, _
xc, yc, zc, xd, yd, zd)
'точки A,B,C,D и их координаты
xa = -15: ya = 20: za = 10
xb = -15: yb = 0: zb = 10
xc = 20: yc = 0: zc = 10
xd = 20: yd = 20: zd = 10
'отбражение точек на экране
RGBcolor = 7
Call Z_четырехугольник(xa, ya, za, xb, yb, zb, _
xc, yc, zc, xd, yd, zd)
'точки A,B,C,D и их координаты
xa = 20: ya = 20: za = -20
xb = 20: yb = 20: zb = 10
xc = 20: yc = 0: zc = 10
xd = 20: yd = 0: zd = -20
'отбражение точек на экране
RGBcolor = 17
Call Z_четырехугольник(xa, ya, za, xb, yb, zb, _
xc, yc, zc, xd, yd, zd)
'ФИГУРА №3
'точки A,B,C,D и их координаты
xa = 0: ya = 10: za = -20
xb = 0: yb = 10: zb = 20
xc = 50: yc = 10: zc = 20
xd = 50: yd = 10: zd = -20
'отбражение точек на экране
RGBcolor = 29
Call Z_четырехугольник(xa, ya, za, xb, yb, zb, _
xc, yc, zc, xd, yd, zd)
'точки A,B,C,D и их координаты
xa = 0: ya = 10: za = 20
Лист
Изм. Колич Лист №док.
.
Подп.
Дата
Формат А4
' Наблюдатель находиться в точке с координатами
Взамен инв.№
Инв.№
подл.
Подпись и дата
xb = 0: yb = -20: zb = 20
xc = 50: yc = -20: zc = 20
xd = 50: yd = 10: zd = 20
'отбражение точек на экране
RGBcolor = 12
Call Z_четырехугольник(xa, ya, za, xb, yb, zb, _
xc, yc, zc, xd, yd, zd)
'точки A,B,C,D и их координаты
xa = 50: ya = 10: za = -20
xb = 50: yb = 10: zb = 20
xc = 50: yc = -20: zc = 20
xd = 50: yd = -20: zd = -20
'отбражение точек на экране
RGBcolor = 9
Call Z_четырехугольник(xa, ya, za, xb, yb, zb, _
xc, yc, zc, xd, yd, zd)
'Треугольник
RGBcolor = 9
Call CAP(131, 76, 120, 88, 131, 96)
Call CAP(121, 106, 120, 88, 131, 96)
RGBcolor = 33
Call CAP(131, 76, 155, 76, 155, 96)
Call CAP(131, 76, 131, 96, 155, 96)
RGBcolor = 32
Call CAP(155, 96, 131, 96, 121, 106)
Call CAP(155, 96, 145, 107, 121, 106)
Call буфер_кадра(50, 170, 50, 170)
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
Взамен инв.№
Подпись и дата
Инв.№
подл.
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
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
Лист
Изм. Колич Лист №док.
.
Подп.
Дата
Формат А4
Взамен инв.№
Подпись и дата
Инв.№
подл.
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
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
Лист
Изм. Колич Лист №док.
.
Подп.
Дата
Формат А4
Взамен инв.№
Подпись и дата
Инв.№
подл.
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)
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
Лист
Изм. Колич Лист №док.
.
Подп.
Дата
Формат А4
kdr(istr, xcol) = 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
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
Инв.№
подл.
Подпись и дата
Взамен инв.№
End If
If ab And bc = True Then
dx = 1
If xab > xbc Then dx = -1
For xcol = Int(xab) To Int(xbc) Step dx
kdr(istr, xcol) = RGBcolor
Next xcol
Лист
Изм. Колич Лист №док.
.
Подп.
Дата
Формат А4
Документ
Категория
Математика
Просмотров
17
Размер файла
140 Кб
Теги
1/--страниц
Пожаловаться на содержимое документа