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

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

Мне нужно нарисовать дугу (центр, начало, длина).

Sub Test()x1 = 3: y1 = 5 ' началоxc = 8: yc = 7  ' центр дугиL = 2 ' длина дугиSet arc1 = AddArcPCL(x1, y1, xc, yc, L) 'первая дугаSet arc1 = AddArcPCL(x1, y1, xc, yc, -L) 'втораяZoomAllEnd SubFunction AddArcPCL(x1, y1, xc, yc, L) As AcadArcR = Sqr((x1 - xc) ^ 2 + (y1 - yc) ^ 2)If R = 0 Then  MsgBox "Error: No Arc"  AddArcPCL = EmptyElsePi = 3.14159265358979If x1 = xc Then  If y1 > yc Then	Angle1 = Pi / 2  Else	Angle1 = -Pi / 2  End IfElse  Angle1 = Atn((y1 - yc) / (x1 - xc))  If x1 < xc Then Angle1 = Angle1 + PiEnd Ifa2 = L / RAngle2 = Angle1 + a2If Angle1 > Angle2 Then  p = Angle2  Angle2 = Angle1  Angle1 = pEnd IfDim centerPoint(0 To 2) As DoublecenterPoint(0) = xc: centerPoint(1) = yc: centerPoint(2) = 0Set AddArcPPR = ThisDrawing.ModelSpace.AddArc(centerPoint, R, Angle1, Angle2)End IfEnd Function

[Rochery]

Добрушанка, скажите пожалуйста а не могли бы вы поэтапно рассказать что и почему вы здесь написали? Так, как рассказывали как юбку нужно программировать.
Я хочу сама научиться писать алогиртмы а не каждый раз спрашитавть как делоть то или это. Хочеться узнать с чего нужно начинать и на что обратить внемание когда собараешся что-то программировать.
Можно на пример брать вами написан алгоритм арки.
Буду очень благодарна, поскольку без этого я немогу двигаться в перед.

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

Добрушанка, скажите пожалуйста а не могли бы вы поэтапно рассказать что и почему вы здесь написали? ... Можно на пример брать вами написан алгоритм арки.

На VB арку можно построить только одной функцией

Set AddArcPPR = ThisDrawing.ModelSpace.AddArc(centerPoint, R, Angle1, Angle2)

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

R = Sqr((x1 - xc) ^ 2 + (y1 - yc) ^ 2)

Теперь найдем начальный угол, как арктангенс отношения разности ординат к раности абсцисс центра и начальной точки.

Angle1 = Atn((y1 - yc) / (x1 - xc))

В случае, когда x1=xc, арктангенс не существует, поэтому нужно выполнить проверку входных данных. Что мы и делаем в следующих строчках

If x1 = xc Then  If y1 > yc Then	Angle1 = Pi / 2  Else	Angle1 = -Pi / 2  End IfElse  Angle1 = Atn((y1 - yc) / (x1 - xc))  If x1 < xc Then Angle1 = Angle1 + PiEnd If

Вычислим разность между начальным и конечным углом арки, зная длину арки и ее радиус.

a2 = L / R

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

Angle2 = Angle1 + a2

Осталось только проверить, чтобы начальный угол был меньше конечного.

If Angle1 > Angle2 Then  p = Angle2  Angle2 = Angle1  Angle1 = pEnd If

[Цветы]

Долго не выходила - не работал компьютер полетела материнская плата. Почти все построения потеряны. Но на форуме сохранились какие, то и собрала пока. Остальное заного строить прийдется, зато пройденный материал повторюВернулась ко всем урокам и так пока не дойду до умаPointR = SavePLine.Coordinate(1)pp = PointR(2): UserForm1.TextBox1.text = IntToStr(pp) -PointR = SavePLine.Coordinate(1)PointR(2) = StrToInt(UserForm1.TextBox1.text)SavePLine.Coordinate(1) = PointRПока не доходит какие значения нужно вставить Я поняла что Coordinate(1)это значение кнопки Label1 Допустим значение кноки Label1 я заполнила так Указала di, а в ControlTipText написала (длина рубашки) Следом для кнопки TextBox1 я написала в ControlTipText (длина рубашки)В этой строке я вместо pp пыталась подставить значение и ничего не получаетсяPointR = SavePLine.Coordinate(1) PointR(2): UserForm1.TextBox1.text = IntToStr(di) -В этой строкеPointR = SavePLine.Coordinate(1)PointR(2) = StrToInt(UserForm1.di.text)SavePLine.Coordinate(1) = PointRМеняю значения и программа пчихает на меня
 
Что я делаю не так

[Цветы]

Sub RestoreData()
Dim PointR As Variant
Dim pp As Double
Call RestoreObject

 

Подскажите какое значение должно быть под именем Координаты
Const_Pi.doc

[Цветы]

Да, на чертеже она есть, но нет координат в программе... я заметила что для VBA важна последовательность операций, то есть если точка К5 начальная, то и описывать ее координаты следует вначале, странно что редактор ошибки не выдал....

 

жду вашу программку где нужно найти точки пересечения окружностей:)

 

Придется заново начинать строить свой пиджак. Половина выкроек слетело из-за неисправности компа Был в ремонте 2 недели.
А пока у меня есть просьба, посмотрите пожалуйста мой документ ворд и подскажите какие координаты надо писать Так пока и не получается получить формую. А Добрушанки пока видно некогда. У вас уже получилось. А то я вставляю данные и программа выдает ошибку и правильно я разместила программки с подпрограммами.
Буду очень признательна вам и вашей помощи.

Изменено 3 марта, 2009 пользователем Цветы

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

Менять нужно данные только в процедуре InitVaribles(). Вы это сделали правильно. В других процедурах формы меняется только КОЛИЧЕСТВО строк. Если у Вас 12 переменных (я поняла, что Вы столько используете для построения), то ничего менять не нужно, поскольку в рассмотренном примере было столько же переменных. Тексты процедур RestoreData(), SaveData() возьмите такие, как в примере на форуме, и НИЧЕГО в них не меняйте.

[Цветы]

Менять нужно данные только в процедуре InitVaribles(). Вы это сделали правильно. В других процедурах формы меняется только КОЛИЧЕСТВО строк. Если у Вас 12 переменных (я поняла, что Вы столько используете для построения), то ничего менять не нужно, поскольку в рассмотренном примере было столько же переменных. Тексты процедур RestoreData(), SaveData() возьмите такие, как в примере на форуме, и НИЧЕГО в них не меняйте.

 

Спасибо! Я восприняла, что данные координат. У меня видно где-то идет ошибка в записи так как если я значения не меняю а просто копирую текст с форума и вставляю в свое построение, то ничего не показывает Может неправильно вставила в свое построение Допустим надо было вставить в конце построения.

Изменено 4 марта, 2009 пользователем Цветы

[Rochery]

Добрушанка, Где вы находите эти формулы:

 

Angle1 = Atn((y1 - yc) / (x1 - xc))

 

 Angle1 = Pi / 2

?

 

Я в математике несильна, но и в интернете не могу их найти.

 

Спасибо.

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

Добрушанка, Где вы находите эти формулы?

Это проходят в школьном курсе математики.

[Rochery]

Это проходят в школьном курсе математики.

Извените пожалуйста, я не знала...

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

Извините, не хотела Вас обидеть. Математика - это моя профессия.

["марина]

Всем доброго времени суток. Какая полезная темка!!! Заболела Автокадом основательно. Спасибо Добрушанка, получила кучу информации и массу удовольствия программируя построение основы брюк. Готовые подпрограммки здорово облегчают жизнь и ускоряют процесс. Строю по Злачевской. Передняя часть практически готова, а вот задняя заставляет задуматься. По методике предусмотрена прибавка на шаг до 3 см. Суть в том, что верхнюю часть основы надо повернуть вокруг определенной точки на выбранную прибавку (до3 см.), при этом нижняя часть не изменяется. Не знаю, понятно ли объяснила. Этот метод применяется при моделировании - например перевод грудной выточки в плечевую.
Вопрос: можно ли каким-то образом описать геом. фигуру, в данном случае трапеция, с помощью точек и повернуть ее вокруг точки, принадлежащей этой трапеции? Или придется искать с помощью пересечения окружностей новое местоположение каждой точки? Или есть какой-либо другой вариант?

Изменено 12 марта, 2009 пользователем "марина

[PAS]

Добрушанка, а у меня тоже вопросик по форме:

В главном меню создается дополнительный пункт "Одежда". Чтобы запустить всю программу, нужно запустить макрос Init().

Пункт "Одежда" у меня создается, но для этого каждый раз при открытии файла приходится запускать макрос Init() заново. Я что-то не так делаю? Что надо сделать, чтобы пункт "Одежда" сразу загружался, как в Вашей программе основы с рукавом? (Программку делаю для племянниц, боюсь запускать их в макросы...)

[Цветы]

Извините, не хотела Вас обидеть. Математика - это моя профессия.

 

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

 

И еще если мы будем также программировать брюки макрос тот же только меняется в макросе наименование модели Например если сейчас у нас юбка, а потом просто нужно менять на Брюки или макрос будет другой для нихSub_ubka__.zip

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

Что надо сделать, чтобы пункт "Одежда" сразу загружался, как в Вашей программе основы с рукавом?

Для того, чтобы меню "Одежда" загружалось автоматически при открытии файла с расширением dwg, нужно выполнить следующие шаги.
1. Создать файл, например Чертеж1.dwg
2. Зайти в меню Сервис/Макросы/Макросы...
3. Выбрать внизу Чертеж1.dwg

4. Вверху написать имя макроса, например Init.

Нажать кнопку Создать.
5. Вместо
Sub Init()
End Sub

вставить весь ваш код.
Теперь вся ваша программа находится внутри файла Чертеж1.dwg, а не в файле проекта VB.
6. Перейдем на ThisDrawing

и выберем AcadDocument
7. Справа выбрать Activate

8. Записать следующий код

Private Sub AcadDocument_Activate()Call InitEnd Sub

9. Сохранить файл и открыть его заново.
P.S. Если у вас уже есть готовая форма, которую вы хотите использовать и здесь, а не строить ее заново, то нужно в файле с расширением dvb (где содержится форма) сделать экспорт формы в файл, а в новом документе (в примере Чертеж1.dwg) сделать импорт формы из файла.

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

Вопрос: можно ли каким-то образом описать геом. фигуру, в данном случае трапеция, с помощью точек и повернуть ее вокруг точки, принадлежащей этой трапеции? Или придется искать с помощью пересечения окружностей новое местоположение каждой точки? Или есть какой-либо другой вариант?

Можно повернуть каждую точку на один и тот же угол, вокруг заданной, при помощи процедуры rotate_beta(x1, y1, x2, y2, beta, LL, x, y). Этот угол можно вычислить. Но честно говоря, мне кажется, что по сложности будет одинаково, что и строить с помощью пересечения окружностей каждую точку.

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

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

 

И еще если мы будем также программировать брюки макрос тот же только меняется в макросе наименование модели Например если сейчас у нас юбка, а потом просто нужно менять на Брюки или макрос будет другой для них

Посмотрела Ваш вариант программы. У Вас не там были объявлены глобальные переменные. ubka01.zip Процедуру построения брюк можно сделать отдельным пунктом меню.

[Цветы]

Процедуру построения брюк можно сделать отдельным пунктом меню.

 

Правильно я поняла, что процедура для брюк будет такая же как для юбки только в названии построения для формы и макроса нужно будет менять (юбку на имя изделия Брюки)
Макрос, который дан сейчас для юбки он одинаков будет для всех построений или нет....

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

Можно и так, но в этом случае, у Вас будут разные проекты. Я бы делала все в одном проекте, добавив кроме юбки еще и процедуру по построению брюк. Меню "Одежда" можно дополнить еще одним пунктом "Построить брюки". Добавить мерки на форму и для брюк, поэтому увеличится количество переменных. Из-за этого нужно переписать соответствующие процедуры.

[Цветы]

Можно и так, но в этом случае, у Вас будут разные проекты. Я бы делала все в одном проекте, добавив кроме юбки еще и процедуру по построению брюк. Меню "Одежда" можно дополнить еще одним пунктом "Построить брюки". Добавить мерки на форму и для брюк, поэтому увеличится количество переменных. Из-за этого нужно переписать соответствующие процедуры.

 

Вы имеете ввиду - допустим талия и бедра одинаковы и в юбке и в брюках только нужно правильно дописать процедуры и расположить мерки и тогда у меня программа будет строить и брюки одновременно с юбкой в одной форме И в построении брюк или юбке нужно внести будет подправку в обозначениях Например ОТ (От) Но тогда для построения брюк нужно еще будет ввести CommandButton как для юбки только вместо слова юбки вставить брюки или объединенно написать (Брюки и юбка)

Изменено 15 марта, 2009 пользователем Цветы

[PAS]

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

 

L = GetCurveLength(SplineObj1)
L = GetCurveLength2(SplineObj1)

 

Первая функция у меня работала как часы, пока программу я загружала напрямую из VB, как только загнала все в форму для мерок - работать отказалась напрочь, пришлось заменять ее на вторую, результат стал гулять в пределах 0-4 мм, зато все работает:)

[Цветы]

 

 

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

Изменено 16 марта, 2009 пользователем Цветы

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

Вы имеете ввиду - допустим талия и бедра одинаковы и в юбке и в брюках ... ... нужно еще будет ввести CommandButton как для юбки только вместо слова юбки вставить брюки или объединенно написать (Брюки и юбка)

Да, Вы правильно поняли, нужно создать еще одну кнопку для построения брюк, или строить одновременно по одной кнопке (как Вам нравится).

Добрушанка, а что нужно еще добавить к программе для того, чтобы не удалять сетку построения, но и при выполнении "Одежда"-юбка сетку небыло видно, как у вас в построении рукава

Не строить вспомогательные линии (закомментируйте соответствующие строки).

И мерки я вставила сама в форму , так как они сами не открываются В чем причина может быть

Когда Вы вводите мерки на форме, они сохраняются в файле dwg, который открыт в настоящий момент (где строится чертеж). Сохраните этот файл. В следующий раз откройте его и запустите программу, мерки должны появится на форме.

[PAS]

Добрушанка, гранд мерси! Форму благополучно импортировала, "Одежда" загружается автоматически, и все работает:))