Урок 8. Тема: Построение поверхности

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

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

Практика

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

Рис. У8.1. Диалоговоеокно Построение поверхности

Рис. У8.2. Результат построения поверхности на рабочем листе

Рис. У8.3. Диалоговое окно Построение поверхности с рисунком построенной поверхности

Обсудим, как приведенная ниже программа решает описанную задачу и что происходит в ней.

Рис. У8.5. Сообщение о некорректном вводе формулы

'

' Описание переменных уровня модуля

'

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

Самостоятельное задание

Разработать приложение с диалоговым окном объемный график (рис. У8.6), которое должно решать следующие задачи:

1. В поле диапазон данных обеспечить ввод диапазона, по которым будет строится объемный график. Диапазон должен состоять не менее, чем из двух строк.

Рис. У8.6. Диалоговое окно Объемный график

Рис. У8.7. Диапазон с данными и результат построения объемного графика на рабочем листе

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