Архив4 / Opyat_kursach_8go_varianta_po_KG / 3 / 3 / 5.9 / 5
.9.doc|
|
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 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
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
|
||||||||
|
Взамен инв.№ |
|
||||||||
|
Подпись и дата |
|
||||||||
|
Инв.№ подл. |
|
||||||||
|
|
|
|
|
|
|
|
|
||
|
|
|
|
|
|
|
||||
|
Изм. |
Колич. |
Лист |
№док. |
Подп. |
Дата |
||||
Формат А4