Тема: Построение поверхности

Цель урока

В данном уроке разрабатывается приложение, которое позволяет по введенному уравнению, начальным и конечным значениям аргументов, а также по шагам их изменения построить поверхность. Кроме того, используя полосы прокрутки можно изменить ориентацию пространственного местоположения поверхности. В процессе создания данного приложения вы узнаете, как:

  • Табулируются функции, зависящие от двух аргументов
  • Осуществляется программная проверка правильности ввода формулы в ячейку рабочего листа
  • Производится преобразование формулы с аргументами х и у в формулу рабочего листа
  • Выполняется программное построение поверхности
  • Записывается диаграмма в графический файл
  • Считывается графический файл в элемент управления image
  • Управлять углом зрения на поверхность
  • Управлять углом поворота поверхности вокруг оси z

Практика
В данном приложении строится поверхность по введенным в диалоговое окно построение поверхности ( 1) начальным, конечным значениям аргументов и их шагах изменения. Уравнение поверхности также вводится в программу из диалогового окна. Уравнение должно быть составлено в соответствии с правилами, по которым строятся функции рабочего листа, но в качестве аргументов в нем следует использовать х и у вместо ссылок на ячейки. Программа сама переведет эти аргументы в ссылки на ячейки. После табуляции введенной функции программой и построения поверхности на рабочем листе ( 2), эта поверхность также отображается в объекте управления image, расположенном в диалоговом окне построение поверхности ( 3). Управляя полосами прокрутки можно изменить ориентацию поверхности на рабочем листе.
Обсудим, как приведенная ниже программа решает описанную задачу и что происходит в ней.

UserForm_Initialize

  1. Активизирует диалоговое окно.
  2. Назначает клавише <Esc> функцию кнопки Отмена, а клавише <Enter> — Построение.
  3. Устанавливает максимальные и минимальные допустимые значения для полос прокрутки, а также их первоначальные значения.
  4. Устанавливает, чтобы отображаемая картинка поверхности в диалоговом окне помещалась целиком и пропорционально в пределах элемента управления Image, а также чтобы левый верхний угол рисунка совпадал с левым верхним углом элемента управления Image.


Нажатие кнопки
Построение запускает на выполнение
процедуру
CornmandButton1_Click

  1. Проверяет, являются ли вводимые данные числами. В случае ошибки отображается соответствующее сообщение.
  2. Проверяет согласованность вводимых данных. В случае ошибки отображается соответствующее сообщение ( 4).
  3. Преобразует формулу, введенную в поле Уравнение поверхности, в формулу рабочего листа.
  4. Проверяет корректность введенной формулы. В случае ошибки отображается соответствующее сообщение ( 5).
  5. Используя метод DataSeriea, начиная с ячейки А2 строит вниз по столбцу арифметическую прогрессию, являющуюся результатом табуляции аргумента х уравнения поверхности с указанными шагами.
  6. Используя метод Dataseries, начиная с ячейки в 1 строит вправо по строке арифметическую прогрессию, являющуюся результатом табуляции аргумента у уравнения поверхности с указанными шагами.
  7. Заносит в ячейку В2 уравнение поверхности, введенное пользователем в диалоговом окне. Для корректности последующего табулирования значений функций важно в уравнении указать абсолютные ссылки на столбец А и строку в. Это обеспечивается вводом в уравнении поверхности вместо аргумента х ссылки $А2, а вместо аргумента у — ссылки в$1.
  8. Для табуляции функции протаскивается маркер заполнения ячейки В2, используя метод AutoFill и формулу поверхности, позволяющих распространить табуляцию на весь диапазон, где табулируется функция.
  9. Строит поверхности при помощи методаChartWizard.
  10. Изменяет ориентацию надписи оси z. и Сохраняет построенную поверхность в файле График-gif. 12. Отображает рисунок из файла График.gif в элементе управления image1.

Нажатие кнопки отмена запускает на выполнение процедуру
CommandButton2 Click

Закрывает диалоговое окно.

ScrollBarl Change

Перемещение ползунка горизонтальной полоски прокрутки вызывает вращение вокруг оси Z диаграммы за счет изменения величины свойства Rotation.

ScrollBar2 Change

Перемещение ползунка вертикальной полоски прокрутки вызывает изменение угла, под которым смотрят на диаграмму, за счет изменения величины свойства Elevation.

ВращениеГрафика

Программирует вращение поверхности за счет
изменения свойств Rotation и Elevation.

'
' Описание переменных уровня модуля
'
Dim УголЗрения as Integer
Dim ВокругОси2 as Integer
Dim УголЗренияСоСчетчика as Integer
'
' УголЗренияСоСчетчика - величина, снимаемая с полосы прокрутки
' и определяющая угол зрения под которым смотрят на поверхность
' УголЗрения - угол зрения, под которым смотрят на поверхность,
' он равен УголЗренияСоСчетчика - 90 и лежит в
'диапазоне от -90 до 90
' ВокругОсиЕ - угол поворота вокруг оси z, лежит в
' диапазоне от 0 до 360
'
Private Sub CommandButtonl_Click()
'
' Процедура табуляции функции
' и построения поверхности
'
Dim х_нз As Double
Dim х_пз As Double
Dim х_шаг As Double
Dim у_нз As Double
Dim у_пз As Double
Dim у_шаг As Double
Dim УрПоверхности As String
'
' Переменная х:
' х_нз - начальное значение
' х_пз - предельное значение
' х_шаг - шаг изменения
' Переменная у:
' у_нз - начальное значение
' у_пз - предельное значение
' у_шаг - шаг изменения
' УрПоверхности - уравнение поверхности
'
Dim nx As Integer
Dim ny As Integer
'
' nx - число протабулированных значений аргумента х
' ny - число протабулированных значений аргумента у
'
Dim n As Integer
Dim i As Integer
'
' n ,i - вспомогательные целые переменные
Dim ПоляВвода(1 То 6) As Object
'
' Массив полей ввода
'
Set ПоляВвода(1) = TextBoxl
Set ПоляВвода(2) = TextBox2
Set ПоляВвода(3) = TextBox3
Set ПоляВвода(4) = TextBox4
Set ПоляВвода(5) = TextBox5
Set ПоляВвода(6) = TextBox6
'
' Проверка корректности ввода данных
'
For i = 1 To 6
If IsNumeric(ПоляВвода(i).Text) = False Then Select Case i
Case 1
MsgBox "Ошибка в начальном значении х", vblnformation, "Поверхность"
TextBox1.SetFocus
Exit Sub
Case 2
MsgBox "Ошибка в начальном значении у", vblnformation, "Поверхность"
TextBox2.SetFocus
Exit Sub
Case 3
MsgBox "Ошибка в шаге х", vblnformation, "Поверхность"
TextBox3.SetFocus
Exit Sub
Case 4
MsgBox "Ошибка в шаге у", vblnformation, "Поверхность"
TextBox4.SetFocus
Exit Sub
Case 5
MsgBox "Ошибка в конечном значении х", vblnformation, "Поверхность"
TextBox5.SetFocus
Exit Sub
Case 6
MsgBox "Ошибка в конечном значении у", vblnformation, "Поверхность"
TextBox6.SetFocus
Exit Sub
End Select
End If
Next i
'
' Считывание с диалогового окна
' значений переменных
'
х_нз = CDbl(TextBoxl.Text)
у_нз = CDbl(TextBox2.Text)
х__шаг = CDbl (TextBox3.Text)
у_шаг = CDbl(TextBox4.Text)
х_пз = CDbl(TextBox5.Text)
у_пз = CDbl(TextBox6.Text)
УрПоверхности = Trim(TextBoxV.Text)
'
' Проверка согласованности введенных данных

'
If х_нз >= х_пз Then
MsgBox "Начальное значение х слишком большое", vblnformation, "Поверхность"
TextBoxl.SetFocus
Exit Sub
End If
If х_нз + х_шаг >= х_пз Then
MsgBox "Шаг х великоват", vblnformation, "Поверхность"
TextBox3.SetFocus
Exit Sub
End If
If у_нз >= у_пз Then
MsgBox "Начальное значение у слишком большое", vblnformation, "Поверхность"
TextBox2.SetFocus
Exit Sub
End If
If у_нз + у_шаг >= у_пз Then
MsgBox "Шаг у великоват", vblnformation, "Поверхность"
TextBox4.SetFocus
Exit Sub
End If
'
'
' Переход на отладчик ошибок в случае их возникновения On Error GoTo Сообщение
' Замена в введенной формуле аргумента х на ссылку $А2,
' а аргумента у на ссылку В$1
'
i=1
Do
'
' Замена в введенной формуле аргумента х на ссылку $А2
'
If Mid(УрПоверхности, i, 1) = "х" Or Mid(УрПоверхности, i, 1) = "X" Then
n = Len(УрПоверхности)
If (1 < i) And (i < n) Then
УрПоверхности = Left(УрПоверхности, i - 1) & "$A2" & Right(УрПоверхности, n - i)
End If
If i = 1 Then УрПоверхности = "$A2" & Right(УрПоверхности, n - 1)
If i = n Then УрПоверхности = Left(УрПоверхности, n - 1) & "$A2"
End If
' Замена в введенной формуле аргумента у на ссылку В$1
If Mid(УрПоверхности, i,1) = "y" Or Mid(УрПоверхности, i, 1) = "Y" Then n = Len(УрПоверхности)
If (1 < i) And (i < n) Then
УрПоверхности = Left(УрПоверхности, i - 1) & "B$l" & Right(УрПоверхности, n - i)
End If
If i = 1 Then УрПоверхности = "B$l" & Right(УрПоверхности, n - 1)
If i = n Then УрПоверхности = Left(УрПоверхности, n - 1) & "B$l"
End If
i = i + 1
Loop While i <= Len(УрПоверхности)
'
' Очистка на активном листе ранее введенных данных
'
ActiveSheet.Cells.Select Selection.Clear
' Заполнение диапазонов значениями аргументов
'
With ActiveSheet
'
' Ввод в ячейку А2 начального значения
'
.Range("A2").Value = х_нз
'
' Создание арифметической прогрессии по столбцу
' с указанными шагом и начальным значением
'
.Range("A2").DataSeries Rowcol:=xlColuims,
Type:=xlLinear, Step:=x__iuar, Stop:=x_ns, Trend:=False
'
' Ввод в ячейку В1 начального значения
'
.Range("Bl").Value = у_нз
'
' Создание арифметической прогрессии вдоль строки
' с указанными шагом и начальным значением
'
.Range("Bl").DataSeries Rowcol:=xlRows,
Type:=xlLinear, Step:=y_iuar, Stop:=y_ns, Trend:=Faise
End With
' Заполнение диапазона значениями функции
'
With ActiveSheet
'
' Определение числа строк в диапазоне заполнения
'
nx = .Range("A1").CurrentRegion.Rows.Count
'
' Определение числа столбцов в диапазоне заполнения
ny = .Range("Al").CurrentRegion.Columns.Count
'
' Ввод уравнения поверхности в ячейку В2
'
.Range("В2").Formula = УрПоверхности
If IsError(Evaluate(УрПоверхности)) = True Then
MsgBox "Ошибка в формуле", vbExclamation, "Поверхность"
Exit Sub
End If
'
' Заполнение диапазона Range(Cells(2, 2), Cells(2, ny))
' начиная с ячейки В2, что эквивалентно протаскиванию маркера
' заполнения ячейки В2 на диапазон
Range(Cells(2, 2), Cells(2, ny))
'
.Range("B2").AutoFill
Destination:=Range(Cells(2, 2), Cells(2, ny)),
Type:=xlFillDefault
' Заполнение диапазона
Range(Cells(2, 2), Cells(nx, ny)),
' начиная с диапазона
Range(Cells(2, 2), Cells(2, ny)),
' что эквивалентно протаскиванию маркера
' заполнения диапазона
Range(Cells(2, 2), Cells(2, ny))
' на диапазон
Range(Cells(2, 2), Cells(nx, ny))
'
.Range(Cella(2, 2), Cells(2, ny)).AutoFill
Destination:=Range(Cells(2, 2),
Cells(nx, ny)),
Type:=xlFillDefault
End With
'
' Удаление с рабочего листа всех ранее построенных диаграмм
'
ActiveSheet.ChartObjects.Delete
'
' Выбор диапазона, по которому строится поверхность
ActiveSheet.Range(Cells(2, 2), Cells(nx, ny)).Select
'
' Задание и выбор области на рабочем листе, где
' будет построена поверхность
'
ActiveSheet.ChartObjects.Add(29.25, 19.5, 270.75, 187'.5).Select Application.CutCopyMode = False
' Построение поверхности
ActiveChart.ChartWizard
Source:=Range(Cells (1, 1), Cells(nx, ny) ),
Gallery:=x13DSurface, Format:=1,
PlotBy:=xlColumns,
CategoryLabels:=1,
SeriesLabels:=l,
HasLegend:=False,
Title:="Поверхность",
CategoryTitle:="x",
ValueTitle:="z",
ExtraTitle:="y" ActiveSheet.ChartObjects(1).Activate
ActiveChart.Axes(xlValue)
.AxisTitle.Select With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Orientation = xlVertical
End With
'
ВращениеГрафика 20, 15
'
' Запись диаграммы в файл и
' загрузка картинки в Imagel
ActiveChart.Export FilterNаmе:="График.gif",
FilterName:="GIF"
UserForml.Image1.Picture = LoadPicture("График.gif") ActiveSheet.Range("Al").Select
'
Exit Sub Сообщение:
MsgBox "Ошибка: " & Err.Description, vbExclamation, "Поверхность"
TextBox7.SetFocus
Exit Sub End Sub
Private Sub CoramandButton2_Click()
'
' Процедура закрытия диалогового окна
UserForml. Hide
End Sub
Private Sub Label7_Click()
End Sub
'
Private Sub ScrollBarl_Change()
' Процедура вращения вокруг оси z
'
'
' Считывание данных с полос прокрутки
'
ВокругОсиZ = ScrollBarl.Value УголЗренияСоСчетчика = ScrollBar2.Value
УголЗрения = УголЗренияСоСчетчика - 90
' Вращение поверхности
'
ВращениеГрафика ВокругОсиг, УголЗрения
End Sub
'
Private Sub ScrollBar2_Change()
' Процедура изменения угла, под которым
' смотрят на диаграмму
' Считывание данных с полос прокрутки
'
ВокругОсиZ = CInt(ScrollBarl.Value)
УголЗренияСоСчетчика = CInt(ScrollBar2.Value)
'
УголЗрения = УголЗренияСоСчетчика - 90
'
' Вращение поверхности ВращениеГрафика ВокругОсиг, УголЗрения
End Sub
'
Sub ВращениеГрафика(ByVal ВокругОсиг, ByVal УголЗрения As Integer)
'
' Процедура вращения поверхности
'
If ActiveSheet.ChartObjects.Count >= 1 Then
ActiveSheet.ChartObjects(I).Activate
With ActiveChart
'
' Угол, под которым смотрят на диаграмму,
' допустимые значения от -90 до 90,
' по умолчанию 15
'
.Elevation = УголЗрения
'
' Вращение вокруг оси z, допустимые значения от 0 до 360,
' по умолчанию 20
'
.Rotation = ВокругОсиг End With
End If
'
End Sub
'
Private Sub UserForm_Initialize()
'
' Процедура инициализации диалогового окна
'
CommandButtonl.Default = True
CoiranandButton2.Cancel = True
ScrollBarl.ControlTipText = "Поворот вокруг оси Z"
ScrollBar2.ControlTipText = "Изменение угла зрения"
' Рисунок масштабируется с учетом относительных размеров так,
' чтобы он помещался в объекте Imagel
'
With Imagel
.PictureAlignment = fmPictureAlignmentTopLeft
.PictureSizeMode = fmPictureSizeModeStretch
End With
'
'
' Установка максимальных и минимальных допустимых значений
' для полос прокрутки, а
' также их первоначальных значений
'
With ScrollBar2
.Min = 0
.Max = 180
.Value = 105
End With
With ScrollBarl
.Min = 0
.Max = 360
.Value =20
End With
UserForml.Show
'
End Sub
Самостоятельное задание
Разработать приложение с диалоговым окном объемный график ( 6), которое должно решать следующие задачи:

  1. В поле диапазон данных обеспечить ввод диапазона, по которым будет строится объемный график. Диапазон должен состоять не менее, чем из двух строк.
  1. Программа должна определить число строк диапазона, а также минимальное (1) и максимальное (число строк диапазона) значение счетчика.
  2. При помощи счетчика установить, какая из строк диапазона будет играть роль абсцисс.
  3. При нажатии кнопки ок должен строиться объемный график с выбранной осью абсцисс ( 7) на рабочем листе и, кроме того, отображаться в объекте image диалогового окна.
  4. С помощью полос прокрутки обеспечить управление ориентацией графика в пространстве.

 

 
На главную | Содержание | < Назад....Вперёд >
С вопросами и предложениями можно обращаться по nicivas@bk.ru. 2013 г. Яндекс.Метрика