Основы программирования на Visual Basic for AutoCAD

[Цветы]

Честно я сначало написала Pi/4оспринила как наклон на 45
А потом когда представила что всетаки 90 должно быть забыла вписать значение назад
А вот что писать надо было Pi-3.1415 я подумала что здесь должно меняться значение в зависимости от поворота угла Вобщем попробую построить что-либо еще чтобы понять до конца

 

Спасибо за исправление ошибок

[Annagirl]

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

Const Pi = 3.1415
Sub klin()
' Мерки
p = 50 ' обхват головы
n = 4 ' количество клиньев
' Точки построения
Dim A(0 To 2) As Double
Dim A1(0 To 2) As Double
Dim A2(0 To 2) As Double
Dim B(0 To 2) As Double
Dim B1(0 To 2) As Double
Dim B2(0 To 2) As Double
Dim B3(0 To 2) As Double
Dim B4(0 To 2) As Double
Dim C1(0 To 2) As Double
Dim C2(0 To 2) As Double
Dim C3(0 To 2) As Double
Dim C4(0 To 2) As Double
' Построение
A(0) = 0: A(1) = 0: A(2) = 0
B(0) = A(0): B(1) = A(1) + p / 4 = 2: B(2) = 0
Set lineobj = ThisDrawing.ModelSpace.AddLine(A, B)
A1(0) = A(0) - (p / n / 2 + 0.5): A1(1) = A(1): A1(2) = 0
A2(0) = A(0) + (p / n / 2 + 0.5): A2(1) = A(1): A2(2) = 0
Set lineobj = ThisDrawing.ModelSpace.AddLine(A, A1)
Set lineobj = ThisDrawing.ModelSpace.AddLine(A, A2)
Set lineobj = ThisDrawing.ModelSpace.AddLine(A1, B)
Set lineobj = ThisDrawing.ModelSpace.AddLine(A2, B)
C1(0) = (A1(0) + B(0)) / 3: C1(1) = (A1(1) + B(1)) / 3: C1(2) = 0
C2(0) = (A2(0) + B(0)) / 3: C2(1) = (A2(1) + B(1)) / 3: C2(2) = 0
Call rotate_beta(C1(0), C1(1), B(0), B(1), Pi / 2, 2, x, y)
B1(0) = x: B1(1) = y: B1(2) = 0
Call rotate_beta(C2(0), C2(1), B(0), B(1), -Pi / 2, 2, x, y)
B2(0) = x: B2(1) = y: B2(2) = 0
Set lineobj = ThisDrawing.ModelSpace.AddLine(B1, C1)
Set lineobj = ThisDrawing.ModelSpace.AddLine(B2, C2)
C3(0) = (B(0) + A1(0)) / 3: C3(1) = (B(1) + A1(1)) / 3: C3(2) = 0
C4(0) = (B(0) + A2(0)) / 3: C4(1) = (B(1) + A2(1)) / 3: C4(2) = 0
Call rotate_beta(C3(0), C3(1), B(0), B(1), Pi / 2, 2, x, y)
B3(0) = x: B3(1) = y: B3(2) = 0
Call rotate_beta(C4(0), C4(1), B(0), B(1), -Pi / 2, 2, x, y)
B4(0) = x: B4(1) = y: B4(2) = 0
Set lineobj = ThisDrawing.ModelSpace.AddLine(B3, C3)
Set lineobj = ThisDrawing.ModelSpace.AddLine(B4, C4)
Set splineobj = Spline_4(B(0), B(1), B2(0), B2(1), B4(0), B4(1), A1(0), A1(1), 0, 0, 0, 0)
Set splineobj = Spline_4(B(0), B(1), B1(0), B1(1), B(0), B3(1), A2(0), A2(1), 0, 0, 0, 0)
End Sub
Sub rotate_beta(x1, y1, x2, y2, beta, LL, x, y)
dx = x2Spline_3 - x1
dy = y2 - y1
l = LL / Sqr(dx ^ 2 + dy ^ 2)
x = x1 + l * (dx * Cos(beta) - dy * Sin(beta))
y = y1 + l * (dx * Sin(beta) + dy * Cos(beta))
End Sub
Function Spline_4(x1, y1, x2, y2, x3, y3, x4, y4, tn_x1, tn_y1, tn_x2, tn_y2) As AcadSpline
Dim startTan(0 To 2) As Double
Dim endTan(0 To 2) As Double
Dim fitPoints(0 To 11) As Double
startTan(0) = tn_x1: startTan(1) = tn_y1: startTan(2) = 0
endTan(0) = tn_x2: endTan(1) = tn_y2: endTan(2) = 0
fitPoints(0) = x1: fitPoints(1) = y1: fitPoints(2) = 0
fitPoints(3) = x2: fitPoints(4) = y2: fitPoints(5) = 0
fitPoints(6) = x3: fitPoints(7) = y3: fitPoints(8) = 0
fitPoints(9) = x4: fitPoints(10) = y4: fitPoints(11) = 0
Set Spline_4 = ThisDrawing.ModelSpace.AddSpline(fitPoints, startTan, endTan)
Spline_4.ElevateOrder (26)
Spline_4.Update
End Function

[Добрушанка]

Исправила мелкие ошибки. И очень довольна Вашими результатами.
Рисунок того, что мы строим.

Const Pi = 3.1415Sub klin()' Меркиp = 50 ' обхват головыn = 4 ' количество клиньев' Точки построенияDim A(0 To 2) As DoubleDim A1(0 To 2) As DoubleDim A2(0 To 2) As DoubleDim B(0 To 2) As DoubleDim B1(0 To 2) As DoubleDim B2(0 To 2) As DoubleDim B3(0 To 2) As DoubleDim B4(0 To 2) As DoubleDim C1(0 To 2) As DoubleDim C2(0 To 2) As DoubleDim C3(0 To 2) As DoubleDim C4(0 To 2) As Double' ПостроениеA(0) = 0: A(1) = 0: A(2) = 0B(0) = A(0): B(1) = A(1) + p / 4 + 2: B(2) = 0Set lineobj = ThisDrawing.ModelSpace.AddLine(A, B)A1(0) = A(0) - (p / n / 2 + 0.5): A1(1) = A(1): A1(2) = 0A2(0) = A(0) + (p / n / 2 + 0.5): A2(1) = A(1): A2(2) = 0Set lineobj = ThisDrawing.ModelSpace.AddLine(A, A1)Set lineobj = ThisDrawing.ModelSpace.AddLine(A, A2)Set lineobj = ThisDrawing.ModelSpace.AddLine(A1, B)Set lineobj = ThisDrawing.ModelSpace.AddLine(A2, B)C1(0) = (A1(0) + 2 * B(0)) / 3: C1(1) = (A1(1) + 2 * B(1)) / 3: C1(2) = 0C2(0) = (A2(0) + 2 * B(0)) / 3: C2(1) = (A2(1) + 2 * B(1)) / 3: C2(2) = 0Call rotate_beta(C1(0), C1(1), B(0), B(1), Pi / 2, 2, x, y)B1(0) = x: B1(1) = y: B1(2) = 0Call rotate_beta(C2(0), C2(1), B(0), B(1), -Pi / 2, 2, x, y)B2(0) = x: B2(1) = y: B2(2) = 0Set lineobj = ThisDrawing.ModelSpace.AddLine(B1, C1)Set lineobj = ThisDrawing.ModelSpace.AddLine(B2, C2)C3(0) = (B(0) + 2 * A1(0)) / 3: C3(1) = (B(1) + 2 * A1(1)) / 3: C3(2) = 0C4(0) = (B(0) + 2 * A2(0)) / 3: C4(1) = (B(1) + 2 * A2(1)) / 3: C4(2) = 0Call rotate_beta(C3(0), C3(1), B(0), B(1), Pi / 2, 1.5, x, y)B3(0) = x: B3(1) = y: B3(2) = 0Call rotate_beta(C4(0), C4(1), B(0), B(1), -Pi / 2, 1.5, x, y)B4(0) = x: B4(1) = y: B4(2) = 0Set lineobj = ThisDrawing.ModelSpace.AddLine(B3, C3)Set lineobj = ThisDrawing.ModelSpace.AddLine(B4, C4)Set splineobj = Spline_4(B(0), B(1), B2(0), B2(1), B4(0), B4(1), A2(0), A2(1), 0, 0, 0, 0)Set splineobj = Spline_4(B(0), B(1), B1(0), B1(1), B3(0), B3(1), A1(0), A1(1), 0, 0, 0, 0)End SubSub rotate_beta(x1, y1, x2, y2, beta, LL, x, y)dx = x2 - x1dy = y2 - y1l = LL / Sqr(dx ^ 2 + dy ^ 2)x = x1 + l * (dx * Cos(beta) - dy * Sin(beta))y = y1 + l * (dx * Sin(beta) + dy * Cos(beta))End SubFunction Spline_4(x1, y1, x2, y2, x3, y3, x4, y4, tn_x1, tn_y1, tn_x2, tn_y2) As AcadSplineDim startTan(0 To 2) As DoubleDim endTan(0 To 2) As DoubleDim fitPoints(0 To 11) As DoublestartTan(0) = tn_x1: startTan(1) = tn_y1: startTan(2) = 0endTan(0) = tn_x2: endTan(1) = tn_y2: endTan(2) = 0fitPoints(0) = x1: fitPoints(1) = y1: fitPoints(2) = 0fitPoints(3) = x2: fitPoints(4) = y2: fitPoints(5) = 0fitPoints(6) = x3: fitPoints(7) = y3: fitPoints(8) = 0fitPoints(9) = x4: fitPoints(10) = y4: fitPoints(11) = 0Set Spline_4 = ThisDrawing.ModelSpace.AddSpline(fitPoints, startTan, endTan)Spline_4.ElevateOrder (26)Spline_4.UpdateEnd Function

Изменено 26 мая, 2008 пользователем Добрушанка

[Добрушанка]

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

Мы знаем координаты точек A и B. Нужно вычислить координаты точки C, если известно, что AC:CB=m:n.

C(0) = (n*A(0) + m*B(0)) / (m+n): C(1) = (n*A(1) +  m*B(1)) / (m+n): C(2) = 0

Для случая, когда AC:CB=2:1, координаты точки C будут иметь такой вид

C(0) = (A(0) + 2*B(0)) / 3: C(1) = (A(1) +  2*B(1)) / 3: C(2) = 0

[Цветы]

Как построить отрезок который проходит через угол начальных координат 45 градусов
Например AB =40 а BC=35 и начальная точка построения будет B(0) и из этой точки надо провести отрезок делящий этот угол пополам Короче иначе биссектриса угла или угол составляющий 45 градусов И если он противоположный то составляет 135

[Добрушанка]

Нужно построить BD, я правильно поняла? А какая длина у этого отрезка?

[Добрушанка]

Изображенный выше рисунок на VB. Длина отрезка BD=dd=15.

Const Pi = 3.1415Sub ugl()aa = 40cc = 35dd = 15Dim A(0 To 2) As DoubleDim B(0 To 2) As DoubleDim C(0 To 2) As DoubleDim D(0 To 2) As DoubleB(0) = 0: B(1) = 0: B(2) = 0A(0) = B(0): A(1) = B(1) + aa: A(2) = 0C(0) = B(0) + cc: C(1) = B(1): C(2) = 0Set lineobj = ThisDrawing.ModelSpace.AddLine(A, B)Set lineobj = ThisDrawing.ModelSpace.AddLine(C, B)Call rotate_beta(B(0), B(1), C(0), C(1), Pi / 4, dd, x, y)D(0) = x: D(1) = y: D(2) = 0Set lineobj = ThisDrawing.ModelSpace.AddLine(D, B)ZoomAllEnd SubSub rotate_beta(x1, y1, x2, y2, beta, LL, x, y)dx = x2 - x1dy = y2 - y1l = LL / Sqr(dx ^ 2 + dy ^ 2)x = x1 + l * (dx * Cos(beta) - dy * Sin(beta))y = y1 + l * (dx * Sin(beta) + dy * Cos(beta))End Sub

Изменено 26 мая, 2008 пользователем Добрушанка

[Добрушанка]

Если рассматривать задачу нахождения биссектрисы угла в общем случае, то для этого нам нужно вычислить угол между двумя отрезками BA и BC.

Чтобы вычислить этот угол, воспользуемся функцией ugol_beta(x1, y1, xc, yc, x2, y2), где (xc,yc) - это вершина угла, (x1,y1) и (x2,y2) - координаты концов отрезков, образующих угол.

Const Pi = 3.1415Sub ugol()Dim A(0 To 2) As DoubleDim B(0 To 2) As DoubleDim C(0 To 2) As DoubleDim D(0 To 2) As DoubleB(0) = 0: B(1) = 0: B(2) = 0A(0) = B(0) + 10: A(1) = B(1) + 15: A(2) = 0C(0) = B(0) + 20: C(1) = B(1): C(2) = 0Set lineobj = ThisDrawing.ModelSpace.AddLine(A, B)Set lineobj = ThisDrawing.ModelSpace.AddLine(C, B)' Вычисляем угол betabeta = ugol_beta(A(0), A(1), B(0), B(1), C(0), C(1)) 'Делаем поворот на угол beta/2Call rotate_beta(B(0), B(1), C(0), C(1), beta / 2, 20, x, y) D(0) = x: D(1) = y: D(2) = 0Set lineobj = ThisDrawing.ModelSpace.AddLine(D, B)ZoomAllEnd SubSub rotate_beta(x1, y1, x2, y2, beta, LL, x, y)dx = x2 - x1dy = y2 - y1l = LL / Sqr(dx ^ 2 + dy ^ 2)x = x1 + l * (dx * Cos(beta) - dy * Sin(beta))y = y1 + l * (dx * Sin(beta) + dy * Cos(beta))End Sub'Вычисление угла (x1,y1)-(xc,yc)-(x2,y2) между отрезками (x1,y1)-(xc,yc) и (x2,y2)-(xc,yc)Function ugol_beta(x1, y1, xc, yc, x2, y2) Cos_beta = ((x1 - xc) * (x2 - xc) + (y1 - yc) * (y2 - yc)) / Sqr(((x1 - xc) ^ 2 + (y1 - yc) ^ 2) * ((x2 - xc) ^ 2 + (y2 - yc) ^ 2)) Sin_beta = Sqr(1 - Cos_beta ^ 2) If Cos_beta <> 0 Then  ugol_beta = Atn(Sin_beta / Cos_beta) Else  ugol_beta = Pi / 2 End IfEnd Function

Изменено 26 мая, 2008 пользователем Добрушанка

[Annagirl]

Очень интересно! Спасибо Вам, Добрушанка, большое!!!
Вот еще возник вопросец.
http://img144.imageshack.us/img144/8829/67978657ha2.jpg
Как построить к панамке такое поле-клеш?
L (на рисунке) = 1/2 Ог (обхват головы)
OA=OA1=R (радиус) = L/Pi/2 (вспоминая геометрию...), где Pi/2 - угол 90 градусов
AB-ширина поля

[Цветы]

 

Контрольная работа Закрепление материала

 

Выточки заднюю и переднюю не стала дорабаьывать ubka_0.zip

[Добрушанка]

L (на рисунке) = 1/2 Ог (обхват головы)
OA=OA1=R (радиус) = L/Pi/2 (вспоминая геометрию...), где Pi/2 - угол 90 градусов
AB-ширина поля

Мне кажется, что L = 1/4 Ог, т.к. мы строим четвертинку. И еще, нужна и вторая ширина поля A1B1.
В VB нужно писать так R=L/(Pi/2 ), а то L/Pi/2 - это то же самое, что L/(2*P).
Сам код программы

Const Pi = 3.1415Sub klesh() OG = 50 Spol1 = 5 'Ширина поля AB Spol2 = 3 ' Ширина поля A1B1 Dim A(0 To 2) As Double Dim B(0 To 2) As Double Dim C(0 To 2) As Double Dim O(0 To 2) As Double Dim A1(0 To 2) As Double Dim B1(0 To 2) As Double L = OG / 4 R = L / (Pi / 2) O(0) = 0: O(1) = 0: O(2) = 0 A1(0) = O(0): A1(1) = O(1) - R: A1(2) = 0 B1(0) = A1(0): B1(1) = A1(1) - Spol2: B1(2) = 0 A(0) = O(0) + R: A(1) = O(1): A(2) = 0 B(0) = A(0) + Spol1: B(1) = A(1): B(2) = 0  Set lineobj = ThisDrawing.ModelSpace.AddLine(O, A) Set lineobj = ThisDrawing.ModelSpace.AddLine(O, A1) Set lineobj = ThisDrawing.ModelSpace.AddLine(B, A) Set lineobj = ThisDrawing.ModelSpace.AddLine(B1, A1) Set arcObj = ThisDrawing.ModelSpace.AddArc(O, R, 3 * Pi / 2, 2 * Pi) k = R + (Spol2 + Spol1) / 2 Call rotate_beta(O(0), O(1), A1(0), A1(1), Pi / 4, k, x, y) C(0) = x: C(1) = y: C(2) = 0 Set SplineObj = Spline_3(B1(0), B1(1), C(0), C(1), B(0), B(1), 1, 0, 0, 1) ZoomAllEnd SubFunction Spline_3(x1, y1, x2, y2, x3, y3, tn_x1, tn_y1, tn_x2, tn_y2) As AcadSplineDim startTan(0 To 2) As DoubleDim endTan(0 To 2) As DoubleDim fitPoints(0 To 8) As Double	startTan(0) = tn_x1: startTan(1) = tn_y1: startTan(2) = 0	endTan(0) = tn_x2: endTan(1) = tn_y2: endTan(2) = 0	fitPoints(0) = x1: fitPoints(1) = y1: fitPoints(2) = 0	fitPoints(3) = x2: fitPoints(4) = y2: fitPoints(5) = 0	fitPoints(6) = x3: fitPoints(7) = y3: fitPoints(8) = 0   Set Spline_3 = ThisDrawing.ModelSpace.AddSpline(fitPoints, startTan, endTan)  Spline_3.ElevateOrder (26)  Spline_3.UpdateEnd FunctionSub rotate_beta(x1, y1, x2, y2, beta, LL, x, y)dx = x2 - x1dy = y2 - y1l = LL / Sqr(dx ^ 2 + dy ^ 2)x = x1 + l * (dx * Cos(beta) - dy * Sin(beta))y = y1 + l * (dx * Sin(beta) + dy * Cos(beta))End Sub

[Добрушанка]

Контрольная работа Закрепление материала

Очень красиво получилось. Мне понравилось. Молодец!

[Annagirl]

Мне кажется, что L = 1/4 Ог, т.к. мы строим четвертинку.

Нет. Все же это половинка. Строится так, чтобы в итоге получилась форма трапеции, а не ровного круга. A1B1 можно сделать равным AB. Или на 1см меньше...
http://img514.imageshack.us/img514/3778/34140285tt6.jpg Изменено 26 мая, 2008 пользователем Annagirl

[Добрушанка]

Тогда в коде программы нужно подправить вместо L = OG / 4 на L = OG / 2.
Получилось у Вас запрограммировать Вашу панамку? На какой возраст ребенка Вы будете ее шить?

Изменено 26 мая, 2008 пользователем Добрушанка

[Annagirl]

У меня их двое: полтора и три года )
Панамки просто строятся, может на бумаге оно даже и легче, но очень хочется научиться строить именно в VB. Кстати, в ажиотаже взялась за детские брючки, но ничего не выходит... Надо еще поразбираться в кодах и подпрограммах, но суть все более проясняется! Спасибо!

[Добрушанка]

А по какой методике Вы строите детские брючки? Я почему спрашиваю, у самой карапуз 1.3 года, на лето хотела сшить шортики и брючки, так что можем вместе заняться построением.

[Цветы]

 

Уже можно пробывать построения платья или брюк Этих знаний достаточно и подпрограмм

[Добрушанка]

Да, достаточно, можно пробовать. Если появятся вопросы по каким-то узлам построения, то будем их решать.

[Annagirl]

Методику построения детских брючек на мальчика особо выбирать не приходится, так как в моем арсенале лишь одна книга, содержащая информацию по построению детской одежды: Костина Е.Я. Раскрой и пошив одежды. (аж 1977 года!!!)
http://img179.imageshack.us/img179/3776/p5270014tp3.jpg
Мерки:
Р=104 (рост)
Ст = 28
Сб = 32
Дтк (длина от талии до колена)=34
Вс = 20
Ок = 26
Осп = 24 (Обхват стопы через пятку!)
Ди = 60
Пб = 2 – 4
Пт = 0,5 – 1

 

Для удобства чертеж передней и задней части выполняют отдельно.
Построение чертежа передней половинки.
В верхнем левом углу листа бумаги ставят т. О и проводят через нее вправо и вниз горизонтальную и вертикальную прямые линии.
ОЯ = В + 1
ОБ=0,1Р+2
ОТ = 0,5 Сб + 1
От т. Б вправо отложить линию до пересечения с линией, прочерченной от т.Т строго вниз, поставить т. Б1
Я1 – точка пересечения вертикальной линии, прочерченной от т.Т строго вниз, и горизонтальной линии, прочерченной от т. Я вправо
Я1Я2 = 0,1Сб
По биссектрисе угла ТЯ1Я2 откладывают 2 см и проводят плавную вогнутую линию
Расстояние между тт.Я и Я2 делят пополам и через точку деления проводят вертикальную линию до линии талии и ставят т. Т1, от которой откладывают длину брюк:
Т1Н = Ди
Т1К=Дтк
НН1=НН2= Осп/4
ТТ2=0,5Ст+Пт
Расстояние от т.О до т.Б делят на три равные части. Т.Т2 соединяют с нижней точкой деления плавной выпуклой линией
КК1=КК2=Ок/4+1
Точки Н1, К2 и Я, а также точки Н2, К1 и я2 соединить.
НН3=1
Оформить линию низа.

[Annagirl]

Вот мой труд! Только вопрос по точке D: она должна проходить по линии OB /3 (по нижней точке, а судя по чертежу, она проходит по верхней).

Const Pi = 3.1415
Sub Brukimalcik()

 

'Мерки
P = 104 'Рост
Ct = 24 'Полуобхват талии
Cb = 25.5 'Полуобхват бедер
Dtk = 28 'Длина от талии до коленной чашечки
Ok = 22 ' Обхват колена
Bc = 17 'Высота сидения
Bcn = 24 'Высота спинки до плеча, высота плеча косая
Di = 50 'Длина изделия
Pb = 3 ' Прибавка по бедрам
Pt = 1 'Прибавка по талии

 

'Описание всех точек
Dim O(0 To 2) As Double
Dim T(0 To 2) As Double
Dim T1(0 To 2) As Double
Dim T2(0 To 2) As Double
Dim B(0 To 2) As Double
Dim B1(0 To 2) As Double
Dim D(0 To 2) As Double
Dim R(0 To 2) As Double
Dim R1(0 To 2) As Double
Dim R2(0 To 2) As Double
Dim R3(0 To 2) As Double
Dim R4(0 To 2) As Double
Dim K(0 To 2) As Double
Dim K1(0 To 2) As Double
Dim K2(0 To 2) As Double
Dim H(0 To 2) As Double
Dim H1(0 To 2) As Double
Dim H2(0 To 2) As Double
Dim H3(0 To 2) As Double

 

Dim LineObj As AcadLine

 

'Построение точек
O(0) = 0: O(1) = 0: O(2) = 0
R(0) = O(0): R(1) = O(1) - (Bc + 1): R(2) = 0
T(0) = O(0) + (Cb / 2 + 1) + 1: T(1) = O(1): T(2) = 0
T2(0) = T(0) - (Ct / 2 + Pt): T2(1) = T(1): T2(2) = 0
R1(0) = T(0): R1(1) = R(1): R1(2) = 0
R2(0) = R1(0) + (Cb / 10): R2(1) = R1(1): R2(2) = 0
B(0) = O(0): B(1) = O(1) - P / 10: B(2) = 0
B1(0) = T(0): B1(1) = B(1): B1(2) = 0
D(0) = O(0): D(1) = (B(1) + O(1)) / 3: D(2) = 0
Call rotate_beta(R1(0), R1(1), R2(0), R2(1), Pi / 4, 2, x, y)
R3(0) = x: R3(1) = y: R3(2) = 0
R4(0) = (R(0) + R2(0)) / 2: R4(1) = R(1): R4(2) = 0
T1(0) = R4(0): T1(1) = T(1): T1(2) = 0
H(0) = T1(0): H(1) = T1(1) - Di: H(2) = 0
'Линия низа
H1(0) = H(0) - (Bcn / 4 + 1): H1(1) = H(1): H1(2) = 0
H2(0) = H(0) + (Bcn / 4 + 1): H2(1) = H(1): H2(2) = 0
H3(0) = H(0): H3(1) = H(1) + 1: H3(2) = 0
' линия колен
K(0) = T1(0): K(1) = T1(1) - Dtk: K(2) = 0
K1(0) = K(0) - (Ok / 4): K1(1) = K(1): K1(2) = 0
K2(0) = K(0) + (Ok / 4): K2(1) = K(1): K2(2) = 0
'построение линий
Set LineObj = ThisDrawing.ModelSpace.AddLine(O, R)
Set LineObj = ThisDrawing.ModelSpace.AddLine(O, T)
Set LineObj = ThisDrawing.ModelSpace.AddLine(T, R1)
Set LineObj = ThisDrawing.ModelSpace.AddLine(R1, R2)
Set LineObj = ThisDrawing.ModelSpace.AddLine(R2, R)
Set LineObj = ThisDrawing.ModelSpace.AddLine(B, B1)
Set LineObj = ThisDrawing.ModelSpace.AddLine(R1, R3)
Set LineObj = ThisDrawing.ModelSpace.AddLine(T1, H)
Set LineObj = ThisDrawing.ModelSpace.AddLine(H1, K1)
Set LineObj = ThisDrawing.ModelSpace.AddLine(K1, R)
Set LineObj = ThisDrawing.ModelSpace.AddLine(R2, K2)
Set LineObj = ThisDrawing.ModelSpace.AddLine(K2, H2)
Set LineObj = ThisDrawing.ModelSpace.AddLine(H1, H3)
Set LineObj = ThisDrawing.ModelSpace.AddLine(H3, H2)
Set LineObj = ThisDrawing.ModelSpace.AddLine(K1, K2)
'Сплайн
Set Splineobj = Spline_3(B1(0), B1(1), R3(0), R3(1), R2(0), R2(1), 0, 0, 0, 0)
Set Splineobj = Spline_2(T2(0), T2(1), D(0), D(1), 0, 0, 0, 0)

 

End Sub
Sub rotate_beta(x1, y1, x2, y2, beta, LL, x, y)
dx = x2 - x1
dy = y2 - y1
l = LL / Sqr(dx ^ 2 + dy ^ 2)
x = x1 + l * (dx * Cos(beta) - dy * Sin(beta))
y = y1 + l * (dx * Sin(beta) + dy * Cos(beta))
End Sub
Function Spline_3(x1, y1, x2, y2, x3, y3, tn_x1, tn_y1, tn_x2, tn_y2) As AcadSpline
Dim startTan(0 To 2) As Double
Dim endTan(0 To 2) As Double
Dim fitPoints(0 To 8) As Double
startTan(0) = tn_x1: startTan(1) = tn_y1: startTan(2) = 0
endTan(0) = tn_x2: endTan(1) = tn_y2: endTan(2) = 0
fitPoints(0) = x1: fitPoints(1) = y1: fitPoints(2) = 0
fitPoints(3) = x2: fitPoints(4) = y2: fitPoints(5) = 0
fitPoints(6) = x3: fitPoints(7) = y3: fitPoints(8) = 0
Set Spline_3 = ThisDrawing.ModelSpace.AddSpline(fitPoints, startTan, endTan)
Spline_3.ElevateOrder (26)
Spline_3.Update
End Function
Function Spline_2(x1, y1, x2, y2, tn_x1, tn_y1, tn_x2, tn_y2) As AcadSpline
Dim startTan(0 To 2) As Double
Dim endTan(0 To 2) As Double
Dim fitPoints(0 To 5) As Double
startTan(0) = tn_x1: startTan(1) = tn_y1: startTan(2) = 0
endTan(0) = tn_x2: endTan(1) = tn_y2: endTan(2) = 0
fitPoints(0) = x1: fitPoints(1) = y1: fitPoints(2) = 0
fitPoints(3) = x2: fitPoints(4) = y2: fitPoints(5) = 0
Set Spline_2 = ThisDrawing.ModelSpace.AddSpline(fitPoints, startTan, endTan)
Spline_2.ElevateOrder (26)
Spline_2.Update
End Function

[Добрушанка]

Вот мой труд! Только вопрос по точке D: она должна проходить по линии OB /3 (по нижней точке, а судя по чертежу, она проходит по верхней).

Отрезок OB делится точкой D в отношении 2:1 от точки О, поэтому координаты точки D имеют вид

D(0) = O(0): D(1) = (2 * B(1) + O(1)) / 3: D(2) = 0

Крайние точки можно соединить и сплайнами:

beta = ugol_beta(K2(0), K2(1), H2(0), H2(1), H2(0) + 1, H2(1))Set Splineobj = Spline_2(R2(0), R2(1), K2(0), K2(1), 0, 0, Cos(beta), Sin(beta))beta = ugol_beta(R(0), R(1), K1(0), K1(1), K1(0) + 1, K1(1))Set Splineobj = Spline_5(T2(0), T2(1), D(0), D(1), B(0), B(1), R(0), R(1), K1(0), K1(1), 0, 0, Cos(beta), Sin(beta))

Долго Вы писали программу? Хорошо все получилось. Молодец!

[Цветы]

Добрушанка
А вы потом научите еще составлять форму для мерок, чтобы можно было менять значение мерок не заходя в VB как у вас

[Добрушанка]

Научу, конечно. Но самое главное - это научиться программировать произвольное построение в VB. A форма используется для того, чтобы "не знающий" пользователь случайно не изменил программу. На разработку и обслуживание интерфейса (формы) уходит достаточно много времени, но само построение, которое осуществляет программа, лучше не становится.

[Annagirl]

Долго Вы писали программу? Хорошо все получилось. Молодец!

 

Спасибо! Писала не очень долго, т.к. быстро поняла суть отображения координат. Дольше исправляла ошибки...

 

beta = ugol_beta(K2(0), K2(1), H2(0), H2(1), H2(0) + 1, H2(1))
Set Splineobj = Spline_2(R2(0), R2(1), K2(0), K2(1), 0, 0, Cos(beta), Sin(beta))
beta = ugol_beta(R(0), R(1), K1(0), K1(1), K1(0) + 1, K1(1))
Set Splineobj = Spline_5(T2(0), T2(1), D(0), D(1), B(0), B(1), R(0), R(1), K1(0), K1(1), 0, 0, Cos(beta), Sin(beta))

 

А что это означает?
и как программируется сплайн по 5 точкам?

[Добрушанка]

Функция для построения пятиточечного сплайна

Function Spline_5(x1, y1, x2, y2, x3, y3, x4, y4, x5, y5, tn_x1, tn_y1, tn_x2, tn_y2) As AcadSplineDim startTan(0 To 2) As DoubleDim endTan(0 To 2) As DoubleDim fitPoints(0 To 14) As DoublestartTan(0) = tn_x1: startTan(1) = tn_y1: startTan(2) = 0endTan(0) = tn_x2: endTan(1) = tn_y2: endTan(2) = 0fitPoints(0) = x1: fitPoints(1) = y1: fitPoints(2) = 0fitPoints(3) = x2: fitPoints(4) = y2: fitPoints(5) = 0fitPoints(6) = x3: fitPoints(7) = y3: fitPoints(8) = 0fitPoints(9) = x4: fitPoints(10) = y4: fitPoints(11) = 0fitPoints(12) = x5: fitPoints(13) = y5: fitPoints(14) = 0Set Spline_5 = ThisDrawing.ModelSpace.AddSpline(fitPoints, startTan, endTan)Spline_5.ElevateOrder (26)Spline_5.UpdateEnd Function