• Rrok
  • Восстановленный участник
  • На форуме с 22 мая 2008г.
  • Сообщений: 1
  • Спасибо: 0

Тема: Excel VBA - пара вопросов!

Помогите пожалуйста с данными задачами:
1)Два отрезка на плоскости заданы координатами своих концов. Определить, имеют ли эти отрезки общие точки.
Примечание:Необходимо рассмотреть различные случаи взаимной ориентации отрезков: на одной прямой, на паралельных прямых или пересекающихся.
2)в массиве T(k) найтипервый и последний нулевые элементы.
3)От каждого из заданых m чисел x1, x2,…,xm отнять их среднее арифметическое: xi = xi – xср ,
  xср = 1/m∑_(i=1)^m xi, i=1,2,…,m.
И что бы результаты были не месте исходных данных!
Зарание спасибо!

  • Anatoly
  • Восстановленный участник
  • На форуме с 23 ноября 2005г.
  • Сообщений: 158
  • Спасибо: 0

Re: Excel VBA - пара вопросов!

Код без проверок и обработки ошибок

Sub inpCoords()
Dim x11 As Double, x12 As Double, y11 As Double, y12 As Double
Dim x21 As Double, x22 As Double, y21 As Double, y22 As Double
x11 = ThisDrawing.Utility.GetReal(vbCr & "Введите координату Х 1-ой точки 1-ой линии: ")
y11 = ThisDrawing.Utility.GetReal(vbCr & "Введите координату Y 1-ой точки 1-ой линии: ")
x12 = ThisDrawing.Utility.GetReal(vbCr & "Введите координату Х 2-ой точки 1-ой линии: ")
y12 = ThisDrawing.Utility.GetReal(vbCr & "Введите координату Y 2-ой точки 1-ой линии: ")
x21 = ThisDrawing.Utility.GetReal(vbCr & "Введите координату Х 1-ой точки 2-ой линии: ")
y21 = ThisDrawing.Utility.GetReal(vbCr & "Введите координату Y 1-ой точки 2-ой линии: ")
x22 = ThisDrawing.Utility.GetReal(vbCr & "Введите координату Х 2-ой точки 2-ой линии: ")
y22 = ThisDrawing.Utility.GetReal(vbCr & "Введите координату Y 2-ой точки 2-ой линии: ")
intersect x11, y11, x12, y12, x21, y21, x22
End Sub
Sub intersect(x11, y11, x12, y12, x21, y21, x22)
s = 0
t1 = 0
d = (y22 - y21) * (x12 - x11) - (x22 - x21) * (y12 - y11)
d1 = (x22 - x21) * (y11 - y21) - (y22 - y21) * (x11 - x21)
If d <> 0 Then
t1 = d1 / d
s = 1
x = x11 + (x12 - x11) * t1
y = y11 + (y12 - y11) * t1
End If
If s = 0 Then MsgBox "Прямые параллельны" Else MsgBox "x=" & x & vbCr & "y=" & y
End Sub