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

[Pavelina]

Добрушанка, правильно ли я поняла , что если я хочу запрограммировать построение юбки, например, то прежде всего я должна самостоятельно присвоить названия всем абсолютно точкам и вести построение от одной отправной точки? Расчет координат пойдет от нее? Или в процессе построения для определения координат я могу пользоваться и другими, уже созданными точкам или участками чертежа?

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

Pavelina, действительно нужно сначало выписать все точки, вычислить их координаты относительно других точек и затем уже программировать.

 

Рассмотрим следующий пример.
Построим сетку чертежа юбки.

 

Все точки, как это описано в построении, будем откладывать от точки T.
В начале программы введем все необходимые мерки. Затем, приняв точку T за начало координат, вычислим координаты всех остальных точек в соответствии с тем, как это описано в методике построения.

 

Sub ubka()

' Ввод мерок
Sb = 50 ' мерка Сб
Psb = 2 ' прибавка Псб к мерке Сб
Dizd = 60 ' длина изделия
TB = 20 ' длина от талии до бедер

Sb = Sb + Psb ' переменную Sb сразу увеличим на прибавку

' Описываем все точки
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 B2(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

' Зададим координаты точки T, от которой мы будем все отсчитывать
T(0) = 0: T(1) = 0: T(2) = 0

' Вычисляем координаты каждой точки относительно точки T
H(0) = T(0): H(1) = T(1) - Dizd: H(2) = 0 ' откладываем точку H вниз от точки Т на величину Dizd
B(0) = T(0): B(1) = T(1) - TB: B(2) = 0 ' откладываем точку B вниз от точки Т на величину TB

T1(0) = T(0) + Sb: T1(1) = T(1): T1(2) = 0 ' откладываем точку T1 вправо от точки Т на величину Sb
B1(0) = B(0) + Sb: B1(1) = B(1): B1(2) = 0 ' откладываем точку B1 вправо от точки B на величину Sb
H1(0) = H(0) + Sb: H1(1) = H(1): H1(2) = 0 ' откладываем точку H1 вправо от точки H на величину Sb

T2(0) = T(0) + 0.5 * Sb - 1: T2(1) = T(1): T2(2) = 0 ' откладываем точку T2 вправо от точки Т на величину 0.5*Sb-1
B2(0) = B(0) + 0.5 * Sb - 1: B2(1) = B(1): B2(2) = 0 ' откладываем точку B2 вправо от точки B на величину 0.5*Sb-1
H2(0) = H(0) + 0.5 * Sb - 1: H2(1) = H(1): H2(2) = 0 ' откладываем точку H2 вправо от точки H на величину 0.5*Sb-1

 

Dim lineObj As AcadLine

 

Set lineObj = ThisDrawing.ModelSpace.AddLine(T, T1)
Set lineObj = ThisDrawing.ModelSpace.AddLine(B, B1)
Set lineObj = ThisDrawing.ModelSpace.AddLine(H, H1)
Set lineObj = ThisDrawing.ModelSpace.AddLine(T, H)
Set lineObj = ThisDrawing.ModelSpace.AddLine(T1, H1)
Set lineObj = ThisDrawing.ModelSpace.AddLine(T2, H2)

 

ZoomAll
End Sub

 

Здесь, например, чтобы вычислить координаты точки H, относительно точки T, нужно от координаты Y точки T отнять Dizd, а координату X точки H оставить такой же, как и координата X точки T.

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

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

...Или в процессе построения для определения координат я могу пользоваться и другими, уже созданными точкам или участками чертежа?

Pavelina, возможен и второй вариант, который Вы написали.
Для этого в программе координаты точки T можно определить не равными нулю (как в предыдующем случае), а равными координатам созданной ранее точки, от которой Вы захотите вести отсчет начала координат. Тогда в строчке T(0) = 0: T(1) = 0: T(2) = 0 вместо нуля вы введете другие числа. Больше нигде ничего менять в программе не нужно.

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

И расскажите подробнее о сохранении VB у меня все чертежи сохраняются обычными файлами в CAD и при открытии не получается загрузить, приходится открывать папку и находить обычный файл-рисунок dwg.

Я рассказывала в первом посте как сохранять проекты VB. Они сохраняются отдельно от файла с чертежом dwg, и имеют расширение dvb. Программа будет строить чертеж в том документе, который активен в АвтоКаде.

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

В этом чертеже хотела построить отрезок H1H2=65 - А1А2=64 А3А4 =63 с разными сторонами и ширина А2Н1=26 А3Н1=28 Напоминающий построение юбки

 

Вот исправленный вариант Вашей программы.
Sub P()
'Построить прямоугольник, где A1A2=64, H1H2=65, A3A4=63 и A2H1=26, A3H1=28

 

a = 64
b = 54
c = 63
d = 26
t = 65

 

'Описание точек построения
Dim A1(0 To 2) As Double
Dim A2(0 To 2) As Double
Dim A3(0 To 2) As Double
Dim A4(0 To 2) As Double
Dim H1(0 To 2) As Double
Dim H2(0 To 2) As Double

 

'Вычисляем координаты точек
A1(0) = 0: A1(1) = 0: A1(2) = 0:
A2(0) = 0: A2(1) = a: A2(2) = 0:
A3(0) = b: A3(1) = c: A3(2) = 0:
A4(0) = b: A4(1) = 0: A4(2) = 0:
H1(0) = d: H1(1) = t: H1(2) = 0:
H2(0) = d: H2(1) = 0: H2(2) = 0: ' В этой строчке была ошибка

 

' Строим отрезки, соединяя соответствующие точки
Dim lineObj As AcadLine

 

Set lineObj = ThisDrawing.ModelSpace.AddLine(A1, A2)
Set lineObj = ThisDrawing.ModelSpace.AddLine(A2, H1)
Set lineObj = ThisDrawing.ModelSpace.AddLine(H1, A3)
Set lineObj = ThisDrawing.ModelSpace.AddLine(A3, A4)
Set lineObj = ThisDrawing.ModelSpace.AddLine(A1, A4)
Set lineObj = ThisDrawing.ModelSpace.AddLine(H1, H2)

 

ZoomAll
End Sub

[Natalya]

Добрушанка, книжку порекомендуйте пожалуста по VB
Я как раз собираюсь книги заказывать.

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

Книгу порекомендовать не могу, их много, я не пользовалась ни одной. Если мне нужна какая-то информация, то я ищу ее в интернете.

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

Покажу, как изменяются координаты точки при сдвиге вправо, влево, вверх или вниз.

Или на VB:

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

В VB есть (как и во многих других языках программирования) возможность повторяющиеся части программы оформлять в виде подпрограмм.
Рассмотрим пример нахождения длин сторон ромба, который образован точками A1, A2, A3 и A4 (см. рисунок в предыдущем посте). Выделим в отдельную подпрограмму нахождение расстояния между двумя точками.
Подпрограммы в VB можно описывать как до основной программы, так и после.
Вот сама программа

 

Sub PodProg()
a = 6
b = 8
' Описание точек
Dim A0(0 To 2) As Double
Dim A1(0 To 2) As Double
Dim A2(0 To 2) As Double
Dim A3(0 To 2) As Double
Dim A4(0 To 2) As Double

 

' Введем координаты точек
A0(0) = 0: A0(1) = 0: A0(2) = 0:
A1(0) = A0(0) + a: A1(1) = A0(1): A1(2) = 0:
A2(0) = A0(0): A2(1) = A0(1) + b: A2(2) = 0:
A3(0) = A0(0) - a: A3(1) = A0(1): A3(2) = 0:
A4(0) = A0(0): A4(1) = A0(1) - b: A4(2) = 0:

 

' Построим ромб
Set lineobj = ThisDrawing.ModelSpace.AddLine(A1, A2)
Set lineobj = ThisDrawing.ModelSpace.AddLine(A2, A3)
Set lineobj = ThisDrawing.ModelSpace.AddLine(A3, A4)
Set lineobj = ThisDrawing.ModelSpace.AddLine(A4, A1)

 

' Найдём длины сторон ромба с помощью подпрограммы Dlina
s1 = Dlina(A1(0), A1(1), A2(0), A2(1)) ' Вычисляем расстояние между точками A1 и A2
MsgBox "Длина первой стороны=" & s1 ' Выводим сообщение

 

s2 = Dlina(A2(0), A2(1), A3(0), A3(1)) ' Вычисляем расстояние между точками A2 и A3
MsgBox "Длина второй стороны=" & s2 ' Выводим сообщение

 

s3 = Dlina(A3(0), A3(1), A4(0), A4(1)) ' Вычисляем расстояние между точками A3 и A4
MsgBox "Длина третьей стороны=" & s3 ' Выводим сообщение

 

s4 = Dlina(A4(0), A4(1), A1(0), A1(1)) ' Вычисляем расстояние между точками A4 и A1
MsgBox "Длина четвёртой стороны=" & s4 ' Выводим сообщение

 

ZoomAll
End Sub

 

' Сама подпрограмма Dlina
Function Dlina(x1, y1, x2, y2) As Double
Dlina = Sqr((x1 - x2) ^ 2 + (y1 - y2) ^ 2)
End Function

 

Чтобы VB знал, какая у вас основная программа, нужно чтобы курсор стоял в любом месте основной программ перед тем, как запустить программу. В нашем случае нужно, чтобы курсор находился в программе PodProg().

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

[Цветы]

Вот исправленный вариант Вашей программы.
Sub P()
' Строим отрезки, соединяя соответствующие точки
Dim lineObj As AcadLine

 

Set lineObj = ThisDrawing.ModelSpace.AddLine(A1, A2)
Set lineObj = ThisDrawing.ModelSpace.AddLine(A2, H1)
Set lineObj = ThisDrawing.ModelSpace.AddLine(H1, A3)
Set lineObj = ThisDrawing.ModelSpace.AddLine(A3, A4)
Set lineObj = ThisDrawing.ModelSpace.AddLine(A1, A4)
Set lineObj = ThisDrawing.ModelSpace.AddLine(H1, H2)

 

ZoomAll
End Sub

При построении любом постоянно будут писаться эти выражения (Set lineObj = ThisDrawing.ModelSpace.AddLine) или меняться
Только добавление точек будет, а выражения эти же, Да

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

Set lineObj = ThisDrawing.ModelSpace.AddLine(A1, A2)
Это выражение строит отрезок, соединяющий две точки.
Если нам нужно, например, построить окружность, то мы вместо AddLine(A1, A2) запишем AddCircle(centerPoint, radius) и получим
Set сObj = ThisDrawing.ModelSpace.AddCircle(centerPoint, radius)

[Цветы]

Set lineObj = ThisDrawing.ModelSpace.AddLine(A1, A2)

 

Продолжение следует

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

Сейчас на примере статьи Юбка Злачевской я покажу, как написать программу по построению юбки.
Нам понадобятся следующие мерки. Все значения берем из этой статьи.

'Ввод мерок Px = 2 Py = 8 Bx = 4 By = 23 Zx = 5.2 Zy = 18 Dp = 109.5 Db = 110 Dz = 110 d1 = 19 D2 = 26.2 OT = 80 OB = 106

Поскольку VB воспринимает одинаково переменные d и D, то d мы обозначили через d1, а D через D2.
Проведем необходимые вычисления (все обозначения и рассуждения взяты из указанной выше статьи).

'Вычисленияs = (Ob - OT) / 2RP = (Px / (Px + Bx + Zx)) * sRB = (Bx / (Px + Bx + Zx)) * sRZ = (Zx / (Px + Bx + Zx)) * sOO1 = D2 / 2 - (d1 / 2 + Px)Shz = Ob / 4 + OO1 'Ширина задней деталиShp = Ob / 4 - OO1 'Ширина передней детали' Распределение боковой вытачкиRBokP = Shp - (OT / 4 + RP)RBokZ = Shz - (OT / 4 + RZ)

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

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

А теперь непосредственно само построение. Я цитирую текст из статьи. После каждого предложения я буду показывать, как это запрограммировать.
Добавлю рисунок того, что мы будем строить (взят также из статьи, но я добавила обозначения нескольких точек).

"...Проводим горизонтальную линию, являющуюся линией низа юбки.
По центру ставим засечку и поднимаем вверх перпендикуляр, на котором откладываем длину юбки по боку..."
Началом отсчета мы сделаем точку N. Итак, эта точка имеет координаты
N(0)=0:N(1)=0:N(2)=0
Тогда Tb(0)=N(0):Tb(1)=N(1)+Db:Tb(2)=0
Для проверки лучше сразу соединять вычисленные точки, что мы и сделаем следующей командой
Set lineobj = ThisDrawing.ModelSpace.AddLine(N, Tb)
Но не забываем, вводя новые точки, описывать их. Т.е. каждый раз сверху нужно добавлять соответствующую строчку с описанием.

Dim N(0 To 2)  As DoubleDim Tb(0 To 2) As Double

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

"...Влево по горизонтали откладываем ширину переднего полотнища юбки по линии бёдер, а вправо - ширину заднего полотнища по линии бедер..."

Np(0)=N(0)-Shp:Np(1)=N(1):Np(2)=0Nz(0)=N(0)+Shz:Nz(1)=N(1):Nz(2)=0Set lineobj = ThisDrawing.ModelSpace.AddLine(Np, Nz)

"...От полученных точек строим вверх, к линии низа, перпендикуляры, на которых соответственно откладываем длину по переду, и длину изделия сзади 60 см..."

Tp(0)=Np(0):Tp(1)=Np(1)+Dp:Tp(2)=0Tz(0)=Nz(0):Tz(1)=Nz(1)+Dz:Tz(2)=0Set lineobj = ThisDrawing.ModelSpace.AddLine(Np, Tp)Set lineobj = ThisDrawing.ModelSpace.AddLine(Nz, Tz)

"...По линии бокового шва опускаемся вниз от талии на величину БY."

B1(0)=Tb(0):B1(1)=Tb(1)-By:B1(2)=0

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

"...Ставим в эту точку ножку циркуля и радиусом, равным БY, проводим дугу - влево и вправо. На переднем полотнище по дуге откладываем величину рассчитанной боковой вытачки, а вправо, на заднем полотнище - величину боковой вытачки сзади. Соединяем полученные точки с точкой."
Здесь нам понадобиться небольшая подпрограммка, которая будет находить точки пересечения двух окружностей. Саму подпрограммку я расположу после основной программы в файле, который приложу ниже. Она будет называться circle2(x0, y0, R0, x1, y1, R1, x, y, flag As Double). А здесь приведу только как ее нужно вызывать. Объясню, что у меня написано в скобках этой подпрограммки.
(x0, y0) - это центр первой окружности радиуса R0, (x1, y1) - центр второй окружности радиуса R1. (x,y) - точка, которую нам нужно найти. Поскольку две окружности пересекаются в двух точках, а нам нужна только одна, то нужно передавать еще один параметр (0 или 1), т.е. вместо переменной flag мы поставим значения 0 или 1. Этот параметр я обычно нахожу опытным путем, запуская программу.

Call circle2(B1(0), B1(1), By, Tb(0), Tb(1), RBokP, x, y, 0)Tbp(0) = x: Tbp(1) = y: Tbp(2) = 0

Соединяю две точки, чтобы проверить, в правильную ли сторону рисуется линия.

Set lineobj = ThisDrawing.ModelSpace.AddLine(Tbp, B1)

Оказывается не в ту сторону, поэтому исправляю

Call circle2(B1(0), B1(1), By, Tb(0), Tb(1), RBokP, x, y, 1)

Перед подпрограммой мы пишем слово Call. Это означает, что мы вызываем нужную нам подпрограмму.
Я стараюсь, многие повторяющие части программы записывать отдельными небольшими подпрограммками. Потом я уже и не помню, как они написаны. Единственно, что мне нужно знать, это что делает конкретная подпрограмма и какие параметры нужно в ней записывать.
И то же самое делаем с боковой выточкой на спинке. Уже становится понятно, что нужно писать в circle2. Если там было 1, то здесь будет 0.
Итак, записываем

Call circle2(B1(0), B1(1), By, Tb(0), Tb(1), RBokZ, x, y, 0)Tbz(0) = x: Tbz(1) = y: Tbz(2) = 0Set lineobj = ThisDrawing.ModelSpace.AddLine(Tbz, B1)

 

"...Заднюю вытачку следует располагать напротив наиболее выпуклых точек фигуры. ... предлагаю расположить вытачку по средине детали."
Найдем вначале точку середины задней детали на талии, т.е. эта точка будет серединой отрезка Tz Tbz.
Она имеет вид:

Tzc(0) = (Tz(0) + Tbz(0)) / 2: Tzc(1) = (Tz(1) + Tbz(1)) / 2: Tzc(2) = 0

Отложим вниз от точки Tzc длину задней вытачки (Zy), получим точку Bzc.

Bzc(0) = Tzc(0): Bzc(1) = Tzc(1) - Zy: Bzc(2) = 0

Хочу отметить, что мы строим вытачки вертикально вниз. Как откладывать под любым углом к линии талии, я покажу в следующий раз.
А теперь, повторяем те же действия, как мы делали выше c боковой выточкой. В результате получим

Call circle2(Bzc(0), Bzc(1), Zy, Tzc(0), Tzc(1), RZ/2, x, y, 0)Tz1(0) = x: Tz1(1) = y: Tz1(2) = 0Set lineobj = ThisDrawing.ModelSpace.AddLine(Tz1, Bzc)Call circle2(Bzc(0), Bzc(1), Zy, Tzc(0), Tzc(1), RZ/2, x, y, 1)Tz2(0) = x: Tz2(1) = y: Tz2(2) = 0Set lineobj = ThisDrawing.ModelSpace.AddLine(Tz2, Bzc)

Соединим между собой еще следующие точки

Set lineobj = ThisDrawing.ModelSpace.AddLine(Tz1, Tz)Set lineobj = ThisDrawing.ModelSpace.AddLine(Tz2, Tbz)

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

"...Предлагаю расположить переднюю вытачку на талии в пропорциях "золотого" сечения, 3:5. Расстояние до стороны передней вытачки сбоку = ОТ:4 х 0.38 ..."
Вычислим точку на линии талии спереди, от которой мы будем откладывать вытачку. На спинке у нас соответствующая точка находилась посередине. Здесь мы отложим в соотношении 3:5.

Tpc(0) = (3*Tp(0) + 5*Tbp(0)) / (3+5): Tpc(1) = (3*Tp(1) + 5*Tbp(1)) / (3+5): Tpc(2) = 0

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

Bpc(0) = Tpc(0): Bpc(1) = Tpc(1) - Py: Bpc(2) = 0 Call circle2(Bpc(0), Bpc(1), Py, Tpc(0), Tpc(1), RP/2, x, y, 0)Tp1(0) = x: Tp1(1) = y: Tp1(2) = 0Set lineobj = ThisDrawing.ModelSpace.AddLine(Tp1, Bpc)Call circle2(Bpc(0), Bpc(1), Py, Tpc(0), Tpc(1), RP/2, x, y, 1)Tp2(0) = x: Tp2(1) = y: Tp2(2) = 0Set lineobj = ThisDrawing.ModelSpace.AddLine(Tp2, Bpc)Set lineobj = ThisDrawing.ModelSpace.AddLine(Tp1, Tbp)Set lineobj = ThisDrawing.ModelSpace.AddLine(Tp2, Tp)

"...Длина вытачек равна ПY =8 см спереди и ЗY=18 см сзади."
Это мы уже запрограммировали, когда строили переднюю и заднюю вытачки.

 

Прилагаю текст программы целиком. Обычно, я построение всех линий переношу в конец текста программы. Если программа большая, мне так проще в ней ориентироваться. В этом файле также находятся и необходимые подпрограммы.
Программа на VB Ubka_Zlach.zip

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

[Цветы]

Спасибо, сейчас будем разбирать урок

[Annagirl]

Спасибо огромное за такие полезные уроки! Я из тех, кто сидит "в кустах". Очень хочу научиться шить, прям тянет еще со школы, но максимум, что я шила это рубашка мужу и деткам панамки-шортики. В основном изучаю, планирую, но до практики очень редко доходит... Сори за офф-топ. Вопрос по-существу: как запрограммировать, например вот такую простенькую основу детской панамки. Интересуют дуги клина, как здесь: http://www.bulav-ka.ru/atel.files/model.fi...ki/det007.htm#1.
Спасибо за внимание. С нетерпением жду уроков!!!!

Изменено 20 мая, 2008 пользователем Annagirl

[Natalya]

Всё очень понятно, но надо очень внимательно записывать координаты, я постоянно путаюсь.

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

Сейчас я покажу, как построить прямую под углом 90 градусов к другой прямой.
Возьмем для примера построение передней вытачки в юбке Злачевской.
В предыдущей программе нужно поправить координаты только одной точки Bpc. В прошлом варианте программы эта точка откладывалась вертикально вниз от точки Tpc. Теперь мы ее отложим от точки Tpc перпендикулярно к прямой TpTbp.
Для этого нам понадобится новая подпрограмма. Она называется rotate_beta(x1, y1, x2, y2, beta, LL, x, y), где (x1,y1) - это точка, относительно которой мы поворачиваем отрезок (x1,y1)-(x2,y2) на произвольный угол beta против часовой стрелки, LL - длина отрезка, который мы должны получить в итоге, (x,y) - наша точка, которую нам нужно найти. Для наглядности прикрепляю рисунок.

Угол beta измеряется в радианах. Напомним, что 180 градусов - это Pi радиан, 90 градусов - это Pi/2 радиан, 60 градусов - это Pi/3 радиан, 45 градусов - это Pi/4 радиан.
В программе также нужно определить число Pi следующей строчкой

Const Pi = 3.1415

Обычно константы располагаются перед всеми частями программы.

 

Возвращаемся к нашему примеру построения вытачки. Код будет иметь такой вид. Я для наглядности соединила еще дополнительно точки (Bpc, Tpc) и (Tp, Tbp).

Call rotate_beta(Tpc(0), Tpc(1), Tp(0), Tp(1), Pi / 2, Py, x, y)Bpc(0) = x: Bpc(1) = y: Bpc(2) = 0Set lineobj = ThisDrawing.ModelSpace.AddLine(Bpc, Tpc)Set lineobj = ThisDrawing.ModelSpace.AddLine(Tp, Tbp)

Прилагаю изменненый вариант всей программы на VB. Там также находится подпрограмма rotate_beta(x1, y1, x2, y2, beta, LL, x, y).
Ubka_Zlach_02.zip

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

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

Для построения сплайна я для себя сделала функции (небольшие подпрограммки), которые будут размещены после основной программы. Я сделала это для того, чтобы не загромождать основную программу. Теперь, когда мне нужно будет построить сплайн, я буду вызывать его только одной строчкой.
Мои подпрограммки по построению сплайнов различаются по количеству точек, через которые будет проходить сплайн.
Для построения сплайна по двум точкам, подпрограммка будет иметь такой вид.
(x1, y1)-это координаты первой точки, (x2, y2)-координаты второй точки,
(tn_x1, tn_y1) - этими значениями задается первая касательная к сплайну,
(tn_x2, tn_y2) - значения для второй касательной к сплайну.

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.UpdateEnd Function

Для построения сплайна по трем точкам, функция выглядит так:

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.UpdateEnd Function

Для сплайна, заданного четырьмя точками, соответственно такой вид:

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.UpdateEnd Function

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

 

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

A1(0)=2:A1(1)=3:A1(2)=0A2(0)=4:A2(1)=5:A2(2)=0A3(0)=6:A3(1)=3:A3(2)=0Set splineObj=Spline_3(A1(0), A1(1),A2(0), A2(1),A3(0), A3(1), 0,0,0,0)

Всем переменным tn_x1, tn_y1, tn_x2, tn_y2, мы передали значение равное нулю. В этом случае касательные на концах сплайна не заданы.

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

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

...как запрограммировать, например вот такую простенькую основу детской панамки. Интересуют дуги клина, как здесь: http://www.bulav-ka.ru/atel.files/model.fi...ki/det007.htm#1.

Так выглядит то, что мы будем строить.

'Описание переменных

OG= 40'Ог (обхват головы) (40) Vk=5'Вк (высота козырька) (5) DlZav=15'Длина завязок =15-20

"Проводят две взаимно перпендикулярные (горизонтальную и вертикальную) линии, пересекающиеся в точке А. Высота косынки. От точки А вверх по вертикальной линии откладывают 30-50 см и ставят точку В: АВ=30 - 50 см."

A(0)=0:A(1)=0:A(2)=0B(0)=A(0):B(1)=A(1)+30:B(2)=0Set lineobj = ThisDrawing.ModelSpace.AddLine(A, B)

"Ширина косынки. От точки А в обе стороны по горизонтальной линии откладывают отрезок, равный 1/2 мерки обхвата головы плюс длина завязок, и ставят точки :
АА1 = АА2 = Ог : 2 + (15-20) = 40 : 2 + (15-20)=35 см."

A1(0)=A(0)-(OG/2+DlZav):A1(1)=A(1):A1(2)=0A2(0)=A(0)+(OG/2+DlZav):A2(1)=A(1):A2(2)=0Set lineobj = ThisDrawing.ModelSpace.AddLine(A1, A2)

"Боковые срезы. Точки А1 и А2 соединяют с точкой В вспомогательными прямыми линиями, а затем плавными выпуклыми кривыми с изгибом у середины вспомогательных линий высотой 1 см."

Set lineobj = ThisDrawing.ModelSpace.AddLine(A1, B)Set lineobj = ThisDrawing.ModelSpace.AddLine(A2, B)C1(0) = (A1(0) + B(0)) / 2: C1(1) = (A1(1) + B(1)) / 2: C1(2) = 0C2(0) = (A2(0) + B(0)) / 2: C2(1) = (A2(1) + B(1)) / 2: C2(2) = 0Call rotate_beta(C1(0), C1(1), B(0), B(1), Pi / 2, 1, x, y)B1(0) = x: B1(1) = y: B1(2) = 0Call rotate_beta(C2(0), C2(1), B(0), B(1), -Pi / 2, 1, x, y)B2(0) = x: B2(1) = y: B2(2) = 0Set lineobj = ThisDrawing.ModelSpace.AddLine(B1, C1)Set lineobj = ThisDrawing.ModelSpace.AddLine(B2, C2)Set Splineobj = Spline_3(A1(0), A1(1), B1(0), B1(1), B(0), B(1), 0, 0, 0, 0)Set Splineobj = Spline_3(A2(0), A2(1), B2(0), B2(1), B(0), B(1), 0, 0, 0, 0)

"Нижний срез. От точки А вниз по вертикальной линии откладывают отрезок, равный высоте козырька, и ставят точку А3: АА3 = Вк = 5 см."

A3(0)=A(0):A3(1)=A(1)-Vk:A3(2)=0Set lineobj = ThisDrawing.ModelSpace.AddLine(A, A3)

"Точки А1, А3 и А2 соединяют плавной кривой."

Set Splineobj = Spline_3(A1(0), A1(1), A3(0), A3(1), A2(0), A2(1), 0, 0, 0, 0)

Построение козырька разберем в следующий раз.
Программа на VB: panamka.zip

[Цветы]

И так застряла. По своему чертежу я предположила что все таки у меня должен быть угол Pi-90 =1.5 (В1В2) Сам треугольник получился но поднять отрезок вверх не смогла Где моя ошибка____________.zip

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

Вставляю Ваш рисунок, чтобы было понятно, что мы программируем.

Исправленный вариант программы

Const Pi = 3.1415Sub TR()'Меркиp = 35h = 1.5'Точки построенияDim A(0 To 2) As DoubleDim B(0 To 2) As DoubleDim C(0 To 2) As DoubleDim B1(0 To 2) As DoubleDim B2(0 To 2) As Double'ПостроениеA(0) = 0: A(1) = 0: A(2) = 0B(0) = A(0): B(1) = A(1) + p: B(2) = 0Set lineobj = ThisDrawing.ModelSpace.AddLine(A, B)C(0) = A(0) - p: C(1) = A(1): C(2) = 0Set lineobj = ThisDrawing.ModelSpace.AddLine(A, C)Set lineobj = ThisDrawing.ModelSpace.AddLine(B, C)'Поделить отрезок СВ пополам и поднять на h смB1(0) = ((C(0) + B(0)) / 2): B1(1) = ((C(1) + B(1)) / 2): B1(2) = 0Call rotate_beta(B1(0), B1(1), B(0), B(1), Pi / 2, h, x, y)B2(0) = x: B2(1) = y: B2(2) = 0Set lineobj = ThisDrawing.ModelSpace.AddLine(B2, B1)Set splineobj = Spline_3(B(0), B(1), B2(0), B2(1), C(0), C(1), 0, 0, 0, 0)End Sub'(x1,y1) - это точка, относительно которой мы поворачиваем отрезок (x1,y1)-(x2,y2)'на угол beta против часовой стрелки, LL - длина отрезка, который мы должны получить в итоге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 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 Function

А теперь об ошибках. Вы забыли описать число Pi. Это делается следующей строчкой, которая размещается вначале программы
Const Pi = 3.1415
Pi - это 180 градусов, чтобы построить угол в 90 градусов, нужно писать Pi/2.
Еще были ошибки в синтаксисе, т.е. в некоторых местах были неправильно раставлены скобки, вместо слова Double было написано Doble.
Сплайн, проходящий через три точки B, B2 и C, программируется следующей строчкой
Set splineobj = Spline_3(B(0), B(1), B2(0), B2(1), C(0), C(1), 0, 0, 0, 0)
Но это все технические ошибки, которые с опытом уменьшаются. Самое главное, это понять логику построения. Из текста программы, я вижу, что Вы уже со многим разобрались.