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

[sune4ka]

Добрушаночка, большое спасибо! @}->--

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

А теперь переходим к самой программе Sune4ka.
Все переменные, обозначающие мерки, которые мы будем вводить в форме, убираем из процедуры Ubka() и объявляем в самом вверху. Такие переменные называются глобальные. Они могут использоваться во всех процедурах программы. Для этого их только одни раз объявляют вначале программы.

Dim Px, Py, Bx, By, Zx, Zy, OT, OB, DP, DB, DZ, DIDim SavePLine As AcadPolyline ' эта пересенная нам понадобится в процедурах InitVaribles,  RestoreData, SaveData

Т.е. мы имеем такой вид

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

Sub InitVaribles() Px = StrToInt(UserForm1.TextBox1.text) Py = StrToInt(UserForm1.TextBox2.text) Bx = StrToInt(UserForm1.TextBox3.text) By = StrToInt(UserForm1.TextBox4.text) Zx = StrToInt(UserForm1.TextBox5.text) Zy = StrToInt(UserForm1.TextBox6.text) OT = StrToInt(UserForm1.TextBox7.text) OB = StrToInt(UserForm1.TextBox8.text) DP = StrToInt(UserForm1.TextBox9.text) DB = StrToInt(UserForm1.TextBox10.text) DZ = StrToInt(UserForm1.TextBox11.text) DI = StrToInt(UserForm1.TextBox12.text)End Sub

Процедура InitVaribles присваивает переменным текст, который вы ввели на форме. Здесь важно не перепутать порядок. Т.е., например, чтобы переменной Px соответствовала компонента TextBox1, в которую на форме мы вводим значение переменной Px.

 

Следующие две процедуры также зависят от количества переменных. На каждую новую переменную добавляются следующие две строчки c соответсвующими Coordinate() и TextBox для процедуры RestoreData

PointR = SavePLine.Coordinate(1)pp = PointR(2): UserForm1.TextBox1.text = IntToStr(pp)

и три строчки для процедуры SaveData (меняются только номер в Coordinate() и TextBox)

PointR = SavePLine.Coordinate(1) PointR(2) = StrToInt(UserForm1.TextBox1.text) SavePLine.Coordinate(1) = PointR

И сами процедуры

Sub RestoreData() Dim PointR As Variant Dim pp As Double Call RestoreObject  PointR = SavePLine.Coordinate(1) pp = PointR(2): UserForm1.TextBox1.text = IntToStr(pp) PointR = SavePLine.Coordinate(2) pp = PointR(2): UserForm1.TextBox2.text = IntToStr(pp) PointR = SavePLine.Coordinate(3) pp = PointR(2): UserForm1.TextBox3.text = IntToStr(pp) PointR = SavePLine.Coordinate(4) pp = PointR(2): UserForm1.TextBox4.text = IntToStr(pp) PointR = SavePLine.Coordinate(5) pp = PointR(2): UserForm1.TextBox5.text = IntToStr(pp) PointR = SavePLine.Coordinate(6) pp = PointR(2): UserForm1.TextBox6.text = IntToStr(pp) PointR = SavePLine.Coordinate(7) pp = PointR(2): UserForm1.TextBox7.text = IntToStr(pp) PointR = SavePLine.Coordinate(8) pp = PointR(2): UserForm1.TextBox8.text = IntToStr(pp) PointR = SavePLine.Coordinate(9) pp = PointR(2): UserForm1.TextBox9.text = IntToStr(pp) PointR = SavePLine.Coordinate(10) pp = PointR(2): UserForm1.TextBox10.text = IntToStr(pp) PointR = SavePLine.Coordinate(11) pp = PointR(2): UserForm1.TextBox11.text = IntToStr(pp) PointR = SavePLine.Coordinate(12) pp = PointR(2): UserForm1.TextBox12.text = IntToStr(pp) Call LockDataEnd SubSub SaveData() Dim PointR As Variant Dim pp As Double Call RestoreObject PointR = SavePLine.Coordinate(1) PointR(2) = StrToInt(UserForm1.TextBox1.text) SavePLine.Coordinate(1) = PointR PointR = SavePLine.Coordinate(2) PointR(2) = StrToInt(UserForm1.TextBox2.text) SavePLine.Coordinate(2) = PointR PointR = SavePLine.Coordinate(3) PointR(2) = StrToInt(UserForm1.TextBox3.text) SavePLine.Coordinate(3) = PointR PointR = SavePLine.Coordinate(4) PointR(2) = StrToInt(UserForm1.TextBox4.text) SavePLine.Coordinate(4) = PointR PointR = SavePLine.Coordinate(5) PointR(2) = StrToInt(UserForm1.TextBox5.text) SavePLine.Coordinate(5) = PointR PointR = SavePLine.Coordinate(6) PointR(2) = StrToInt(UserForm1.TextBox6.text) SavePLine.Coordinate(6) = PointR PointR = SavePLine.Coordinate(7) PointR(2) = StrToInt(UserForm1.TextBox7.text) SavePLine.Coordinate(7) = PointR PointR = SavePLine.Coordinate(8) PointR(2) = StrToInt(UserForm1.TextBox8.text) SavePLine.Coordinate(8) = PointR PointR = SavePLine.Coordinate(9) PointR(2) = StrToInt(UserForm1.TextBox9.text) SavePLine.Coordinate(9) = PointR PointR = SavePLine.Coordinate(10) PointR(2) = StrToInt(UserForm1.TextBox10.text) SavePLine.Coordinate(10) = PointR PointR = SavePLine.Coordinate(11) PointR(2) = StrToInt(UserForm1.TextBox11.text) SavePLine.Coordinate(11) = PointR PointR = SavePLine.Coordinate(12) PointR(2) = StrToInt(UserForm1.TextBox12.text) SavePLine.Coordinate(12) = PointR Call LockDataEnd Sub

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

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

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

Вот все необходимые процедуры и функции.

Function StrToInt(text As String) As DoubleFor i = 1 To Len(text) If Mid(text, i, 1) = "," Then  text = Mid(text, 1, i - 1) & "." & Mid(text, i + 1, Len(text) - i) End IfNext StrToInt = Val(text)End FunctionFunction IntToStr(eerr As Double) As StringStr1 = Str(eerr)If Mid(Str1, 2, 1) = "." ThenIntToStr = Mid(Str1, 1, 1) & "0" & Mid(Str1, 2, Len(Str1) - 1)ElseIntToStr = Str1End IfEnd FunctionSub CreatePline()Const N = 100Dim layerObj As AcadLayerSet layerObj = ThisDrawing.Layers.Add("Data")Dim Points(0 To N * 3 - 1) As DoubleFor i = 0 To 3 * N - 1 Points(i) = -100Next iSet SavePLine = ThisDrawing.ModelSpace.AddPolyline(Points)SavePLine.UpdateSavePLine.Layer = "Data"SavePLine.Visible = FalselayerObj.Lock = TrueEnd SubSub RestoreObject1()	Dim layerColl As AcadLayers	Set layerColl = ThisDrawing.Layers	Dim entry As AcadEntity	i = 0	For Each entry In ThisDrawing.ModelSpace		i = i + 1		MsgBox entry.ObjectName	NextEnd SubSub RestoreObject()	Dim layerColl As AcadLayers	Set layerColl = ThisDrawing.LayersFor i = 1 To layerColl.Count - 1If layerColl.Item(i).Name = "Data" ThenlayerColl.Item(i).Lock = FalseEnd IfNext	Dim entry As AcadEntity	i = 0	Check = False	Check1 = False	For Each entry In ThisDrawing.ModelSpace		i = i + 1		If entry.ObjectName = "AcDb2dPolyline" And Check = False Then			   Set SavePLine = entry			   Check = True			   SavePLine.Update			   SavePLine.Visible = False		End If	 Next	If Not Check Then	  Call CreatePline	End IfEnd SubSub LockData()	Dim layerColl As AcadLayers	Set layerColl = ThisDrawing.LayersFor i = 1 To layerColl.Count - 1If layerColl.Item(i).Name = "Data" ThenlayerColl.Item(i).Lock = TrueEnd IfNextEnd Sub

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

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

Private Sub UserForm_Initialize()Call ThisDrawing.RestoreDataEnd Sub

Чтобы добавить его, нужно открыть форму и дважды щелкнуть по любой кнопке.
Мерки сохраняются в файле AutoCad с расширением dwg.
Если мы оставим программу в таком виде, то нам нужно форму запускать из VB.
Как сделать меню, из которого можно будет вызывать форму, напишу в следующий раз.

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

[sune4ka]

с нетерпением будем ждать:)

Изменено 26 января, 2009 пользователем sune4ka

[Цветы]

Спасибо Добрушанка!
Чуть не прокараулила темку (уведомления небыло почемуто)

 

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

[Цветы]

Добрушанка, а у нас на верху перед мерками написана начальная строка программки Мерки расписывать под ней прям

 

Const Pi = 3.1415
Sub Основа_без_выточек()

 

аааааааааааааааааааааааааааааааааааа

 

МЕРКИ:

 

Kh = 168 'Рост
Bu = 84 'Обхват груди
Tu = 66 'Обхват талии
Hu = 90 'Обхват бедер

[sune4ka]

посмотрите вот тут видно
http://club.season.ru/index.php?act=Attach...st&id=44827
мерки вы объявляете до самой программы, прежние вам уже не нужны:) их можно удалить

[Цветы]

quote name='sune4ka' post='137033' date='Jan 27 2009, 08:14']
посмотрите вот тут видно
http://club.season.ru/index.php?act=Attach...st&id=44827
мерки вы объявляете до самой программы, прежние вам уже не нужны:) их можно удалить

 

Я это смотрела так и сделала но вот тут еще надо видно указывать точки построения так как у меня мерки невстали Видно что-то напутала

[attachmentid=45339]

 

[/code]1.zip

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

Const_Pi.zip

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

[sune4ka]

по моему вы лениво все с'copy-paste-или:))))

 

у вас сразу после программки Sub InitVaribles()
идет вот такая запись:

 

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

 

это зачем? если вы все тоже самое описываете уже в программке Sub RestoreData() ??

 

еще у вас есть синтаксические ошибки, просмотрите все внимательнее, кпримеру в программе Sub SaveData() у вас пропущена точка
PointR(2) = StrToInt(UserForm1p4.text) должно быть я думаю вот так:
PointR(2) = StrToInt(UserForm1.p4.text) если конечно р4 - это кнопочка TextBox которую вы переименовали...

Изменено 28 января, 2009 пользователем sune4ka

[Цветы]

еще у вас есть синтаксические ошибки, просмотрите все внимательнее, кпримеру в программе Sub SaveData() у вас пропущена точка
PointR(2) = StrToInt(UserForm1p4.text) должно быть я думаю вот так:
PointR(2) = StrToInt(UserForm1.p4.text) если конечно р4 - это кнопочка TextBox которую вы переименовали...

 

В том то и загвозка, если я ставлю точку, то программа выдает ошибку и тогда я удаляю точку то программа успокаивается но все время еще показывает на точки построения К1 - точки координат построения. Буду конечно еще искать ошибки.

[sune4ka]

Добрушанка, подскажите пожалуйста, может быть вы знаете...уже отчаялась найти в интернете...
как сообщение в MsgBox разбить на абзацы? к примеру
MsgBox("рукав невозможно построить. Дуги плечевого среза полочки и нагрудной вытачки не пересекаются. ...." окно сильно растягивается, а хотелось бы чтобы имел компкатный вид:))

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

Добрушанка, подскажите пожалуйста, может быть вы знаете...уже отчаялась найти в интернете...
как сообщение в MsgBox разбить на абзацы? к примеру
MsgBox("рукав невозможно построить. Дуги плечевого среза полочки и нагрудной вытачки не пересекаются. ...." окно сильно растягивается, а хотелось бы чтобы имел компкатный вид:))

Для того, чтобы фразы разбивались на абзацы, нужно в текст вставлять символ переноса строки. Его код 13.

MsgBox ("рукав невозможно построить." & Chr(13) & "Дуги плечевого среза полочки и нагрудной вытачки не пересекаются. ....")

[PAS]

Добрушанка, спасибо Вам огромное за материал! Давно уже облизывалась на Visual Basic и лишь недавно нашла время засесть "за уроки" - после добросовестного изучения этой темы удалось даже самостоятельно прописать построение основы - мне, совершенно нулевому человеку в этой области!

 

Споткнулась я и пока застряла, когда с разгону взялась за построение рукава и воротника... Тут у меня появились вопросы, связанные со сплайнами (хоть построение рукава и воротника и прописала, но вопросы остались) :

 

- возможно ли прописать процедуру измерения длины сплайна? (пыталась привязать ширину рукава к длине проймы основы, так и ничего не придумав, запускаю программу дважды - сначала измеряю пройму, ввожу эти данные, и опять запускаю, чтобы построить и рукав... та же история с шириной горловины и воротником...)

 

- как отмерить опять же на сплайне необходимую длину?(это я уже с контрольными мерками воевала...) а поделить его, к примеру, поплам?

 

Я, наверное, как дилетант, нереальные вопросы задаю, но если Вы мне ответите, что это невозможно, я, по крайней мере, мучиться на эту тему перестану:))

Изменено 2 февраля, 2009 пользователем PAS

[Цветы]

На языке VB условие задается так

  If ОО1 > 2 Then   Shp = ob / 4 - OO1 / 2        

Об этих примерах (уравнениях )расскажите немного побольше на любых примерах Допустим я соединила прямую наклонную тА с точкой А1 и как можно задать ей выражение что она равна какой-либо мерке допустим Vpk. Чтобы эта прямая в дальнейшем отвечала при изменении этой мерки
Есть такое в базике

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

[sune4ka]

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

 

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

Изменено 3 февраля, 2009 пользователем sune4ka

[sune4ka]

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

буду ее потом дорабатывать - двухшовный рукав и рукав для критичных фигур - в перспективе:))

еще бы формочку сделать...застряла пока на радиокнопках..

Изменено 3 февраля, 2009 пользователем sune4ka

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

Из того, что заметила, в построении рукава не совпадают точки P1 и P2. Должен быть плавный переход от одного сплайна к другому, т.е. соответствующие вектора касательных должны совпадать.

[sune4ka]

хмм...а я и не заметила:))) попробую сделать один единый сплайн..

Изменено 4 февраля, 2009 пользователем sune4ka

[sune4ka]

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

 

Добрушанка, когда же будет обещаный следующий раз?;)

 

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

[Rochery]

Добрушанка,
Скажите пожалуйста, а где вы ищите информации в интернете для VB?

[sune4ka]

Добрушанка, похоже засыплем мы вас вопросами:))))

 

Rochery, я кпримеру просто пишу в гугле что мне надо... это "надо" конечно обязательно и всегда там находится, только вот поймете ли вы что с ним делать:)))
есть немного вот здесь
http://www.askit.ru/custom/vba_office/m3/0...n_functions.htm
еще вот здесь
http://www.intuit.ru/department/pl/vbnet/5/7.html
посмотрите по оглавлению...
и здесь
http://on-line-teaching.com/vba/lsn008.html

 

да кстати, что вы ищите?;)

Изменено 5 февраля, 2009 пользователем sune4ka

[Rochery]

sune4ka, большое спасибо.
Я не очень понимаю этих подпрограм. Я не все понимаю что в них написано. И еще: мы их создаем каждый раз когда пишем озновную программу, или один раз создали, сохранили и потом кода нужо - вызываем?

[sune4ka]

sune4ka, большое спасибо.
Я не очень понимаю этих подпрограм. Я не все понимаю что в них написано. И еще: мы их создаем каждый раз когда пишем озновную программу, или один раз создали, сохранили и потом кода нужо - вызываем?

да, мы их пишем заново - copy-paste-им:))))
вначале я тоже не понимала что это такое и с чем его едят:))))
они помогают экономить время и место, если вы выполняете ряд операций несколько раз.. попрограмма это некая "формула" если так можно выразиться...подставляете значение и получаете ответ.. я попробую вам примерчик придумать...попозже..

[Rochery]

sune4ka, большое спасибо за помощь.
Я знаю зачем подпрограммы нужны, но не совсем понимаю что там написано и я сама самостоятельно не смогла-бы ее написать.