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

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

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

На VB это записывается так.

Sub splain()Dim A(0 To 2) As DoubleDim B(0 To 2) As DoubleDim C(0 To 2) As DoubleDim D(0 To 2) As DoubleDim E(0 To 2) As DoubleA(0) = 0: A(1) = 0: A(2) = 0B(0) = 10: B(1) = 20: B(2) = 0C(0) = 15: C(1) = 10: C(2) = 0D(0) = 25: D(1) = 15: D(2) = 0E(0) = 30: E(1) = 40: E(2) = 0Set LineObj = ThisDrawing.ModelSpace.AddLine(A, B)Set LineObj = ThisDrawing.ModelSpace.AddLine(D, E)Set Splineobj = Spline_3(B(0), B(1), C(0), C(1), D(0), D(1), 0, 0, 0, 0)ZoomAllEnd Sub

А теперь зададим сплайн таким образом, чтобы он плавно переходил из отрезка АВ в отрезок DE.

Или на VB

Sub splain()Dim A(0 To 2) As DoubleDim B(0 To 2) As DoubleDim C(0 To 2) As DoubleDim D(0 To 2) As DoubleDim E(0 To 2) As DoubleA(0) = 0: A(1) = 0: A(2) = 0B(0) = 10: B(1) = 20: B(2) = 0C(0) = 15: C(1) = 10: C(2) = 0D(0) = 25: D(1) = 15: D(2) = 0E(0) = 30: E(1) = 40: E(2) = 0Set LineObj = ThisDrawing.ModelSpace.AddLine(A, B)Set LineObj = ThisDrawing.ModelSpace.AddLine(D, E)Set Splineobj = Spline_3(B(0), B(1), C(0), C(1), D(0), D(1), B(0) - A(0), B(1) - A(1), E(0) - D(0), E(1) - D(1))ZoomAllEnd Sub

Оба сплайна на одном рисунке для сравнения.

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

[Цветы]

 

Урок нужен на следующую тему: Если линию нужно вынести параллельно или линии повторяются Например в брюках выразимся что сетка переда должна сохраниться рядом для построения задней половинки. И если линия длины переносится параллельно

[Цветы]

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

[Alena-autocad]

эх....... такая тема!!!!!! и обрыв связи с Добрушанкой......Леночка, плииииз, не покидайте нас!!! (слёзно и с надрывом в голосе)
Я Очень жду продолжения!!!

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

После длительного перерыва приступим к нашим урокам.
Рассмотрим следующий пример.
Построим прямоугольный треугольник A1A2A3, у которого A1A2=a, A1A3=b. На стороне A1A2 мы возьмем точку B1 на расстоянии c от A1. Нам нужно построить отрезок B1B2, который параллелен отрезку A1A3, и точка B2 лежит на отрезке A2A3.

 

 

Координаты точки B2 мы получим как пересечение отрезков A2A3 и B1B3.
Вычисление координат пересечения двух отрезков реализовано в отдельной процедуре, которая вызывается в основной программе следующим образом
Call peres_otr(x1, y1, x2, y2, x3, y3, x4, y4, x, y), где Call - это служебное слово, которое вызывает процедуры; peres_otr - это имя процедуры, а в скобках передаются параметры. В данном случае координаты концов двух отрезков (x1,y1)-(x2,y2) и (x3,y3)-(x4,y4). (x,y) - это координаты точки пересечения.

Sub treugolnik()a = 100b = 60c = 30 'Описываем все точки, из которых будет состоять наш треугольник Dim A1(0 To 2) As Double Dim A2(0 To 2) As Double Dim A3(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 ' Вычисляем координаты каждой точки A1(0) = 0: A1(1) = 0: A1(2) = 0 A2(0) = 0: A2(1) = a: A2(2) = 0 A3(0) = b: A3(1) = 0: A3(2) = 0 B1(0) = 0: B1(1) = c: B1(2) = 0 B3(0) = b: B3(1) = c: B3(2) = 0 ' Вычислим координаты точки B2 Call peres_otr(B1(0), B1(1), B3(0), B3(1), A2(0), A2(1), A3(0), A3(1), B2(0), B2(1)) B2(2) = 0 ' Строим отрезки, соединяя соответствующие точки Dim lineObj As AcadLine Set lineObj = ThisDrawing.ModelSpace.AddLine(A1, A2) Set lineObj = ThisDrawing.ModelSpace.AddLine(A2, A3) Set lineObj = ThisDrawing.ModelSpace.AddLine(A3, A1) Set lineObj = ThisDrawing.ModelSpace.AddLine(B1, B2)ZoomAllEnd Sub'уравнение прямой по двум точкам (x1,y1) и (x2,y2)Sub o_urav(x1, y1, x2, y2, AP, BP, CP) If x1 = x2 And y1 = y2 Then  AP = 0: BP = 0: CP = 0 Else  AP = y2 - y1  BP = x1 - x2  CP = -AP * x1 - BP * y1  kof = Sqr(AP * AP + BP * BP)  AP = AP / kof  BP = BP / kof  CP = CP / kof End IfEnd Sub' координаты точки пересечения двух прямыхSub peres_pr(AP1, BP1, CP1, AP2, BP2, CP2, x, y) Delta = AP1 * BP2 - BP1 * AP2 If Delta = 0 Then  MsgBox "Ошибка. Точки пересечения не существует."  Else  x = -(CP1 * BP2 - BP1 * CP2) / Delta  y = -(AP1 * CP2 - CP1 * AP2) / Delta End IfEnd Sub' координаты точки пересечения двух отрезков (x1,y1)-(x2,y2) и (x3,y3)-(x4,y4)Sub peres_otr(x1, y1, x2, y2, x3, y3, x4, y4, x, y) Call o_urav(x1, y1, x2, y2, AP1, BP1, CP1) Call o_urav(x3, y3, x4, y4, AP2, BP2, CP2) Call peres_pr(AP1, BP1, CP1, AP2, BP2, CP2, x, y)End Sub

 

Такой вид имеет наша программа на VB.

 

Вот, что мы в итоге получим.

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

[Цветы]

Наконец-то появилось продолжение Спасибо! Не покидайте нас Давайте до конца изучим

[vadsura]

где Call - это служебное слово, которое вызывает процедуры; peres_otr - это имя процедуры, а в скобках передаются параметры. В данном случае координаты концов двух отрезков (x1,y1)-(x2,y2) и (x3,y3)-(x4,y4). (x,y) - это координаты точки пересечения.Sub o_urav(x1, y1, x2, y2, AP, BP, CP)

 

Здравствуйте, можно поподробнее что за параметры ..., AP, BP, CP)

[vadsura]

Просьба не бить ногами по лицу.
Я пытаюсь освоить Corel VBA. Так что мне надо с подробностями, мне еще 2 ной перевод делать.
За уроки огромное спасибо. Литературы по вба хватает, но она на 85 % под эксель заточена.

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

что за параметры ..., AP, BP, CP)

Рассмотрим процедуру Sub o_urav(x1, y1, x2, y2, AP, BP, CP). В ней мы передаем координаты двух точек (параметры x1, y1, x2, y2) и получаем на выходе из процедуры коэффициенты уравнения прямой (параметры AP, BP, CP). У нас используются уравнения прямой на плоскости вида AP*x+ BP*y+CP=0.

[vadsura]

Воо, понятно, спасибо.

 

Еще бы разобрать на примере такой метод как
"точка на линии" понятно что интересно на сплайне.

 

http://s61.radikal.ru/i174/0809/bc/ac9a4bcb7730t.jpg
Есть идея со школьного курса с дифф исчислением.
Т.е. откладывать малыми радиусами, аппроксимируя кривую.
Организовать циклик например и откладывать по 1\100 от нужной величины.

 

Или есть более простой способ?

Изменено 25 сентября, 2008 пользователем vadsura

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

Методов построения сплайна множество. Какой именно используется в AutoCad, неизвестно. Свойства объекта spline не позволяют выяснить координаты любой точки сплайна. Можно использовать приближенную модель сплайна, построеную отрезками по точкам ControlPoints, предварительно максимально повысив порядок сплайна командой Spline.ElevateOrder (26).

[vadsura]

Вы меня не поняли.
Мы уже имеем сплайн и на нем надо поставить точку на расстоянии определенном по кривой.
А как рисовать сплайн мы уже разбирали.

[vadsura]

Свойства объекта spline не позволяют выяснить координаты любой точки сплайна

А пересечение сплайна и окружности можно получить?

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

Я как раз про то и писала, как на сплайне найти определенную точку. Если аппроксимировать сплайн в виде набора отрезков, только после этого можно найти координаты любой точки на сплайне (приближенно, поскольку на самом деле эта точка будет находиться на аппроксимирующей ломаной). Я предлагаю строить ломаную по ControlPoints, как по наиболее близким точкам к сплайну, при условии, что сплайн имеет максимально возможный порядок в AutoCad. Не зная метода построения сплайна (я имею ввиду, не зная уравнений, по которым он построен), Вы не можете вычислить координаты произвольной точки сплайна.

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

Рассмотрим следующую задачу, которая возникает при построении брюк Мюллера (Ателье 03/2006, с. 35-36).

Нам нужно найти точку 27, которая получается следующим образом: под прямым углом к средней линии задней половинки отложить до пересечения с продленной линией бедер значение Шзп.

Эта задача сводится к следующей:
На прямой 24-25 от точки 24 откладываем расстояние, равное Шзп. Получаем точку F, от которой далее мы построим перпендикуляр F-FF. Пересечение прямой F-FF с продленной линией бедер как раз и даст нам искомую точку 27.

Программа на VB.

Sub Bruki_M01()' Описание точекDim A24(0 To 2) As DoubleDim A25(0 To 2) As DoubleDim F(0 To 2) As DoubleDim FF(0 To 2) As DoubleDim A27(0 To 2) As Double' Введем координаты точекA24(0) = 30: A24(1) = 30: A24(2) = 0:A25(0) = 20:  A25(1) = 27:  A25(2) = 0:SHzp = 26' Найдем точку Fk = SHzp / Dlina(A24(0), A24(1), A25(0), A25(1))F(0) = A24(0) - (A24(0) - A25(0)) * kF(1) = A24(1) - (A24(1) - A25(1)) * kF(2) = 0' построим точку FF, так что отрезок FF-F перпендикулярен отрезку F-A24Call rotate_beta(F(0), F(1), A24(0), A24(0), Pi / 2, 1, FF(0), FF(1))FF(2) = 0' Найдем пересечение прямой FF-F с линией бедер, которая проходит через точку A24' Находим уравнение прямой FF-FCall o_urav(FF(0), FF(1), F(0), F(1), AP1, BP1, CP1)' Находим уравнение линии бедер, которая проходит через точку A24Call o_urav(A24(0), A24(1), A24(0) - 1, A24(1), AP2, BP2, CP2)' Найдем пересечение, т.е. точку A27Call peres_pr(AP1, BP1, CP1, AP2, BP2, CP2, A27(0), A27(1))A27(2) = 0' Соединим точкиSet lineobj = ThisDrawing.ModelSpace.AddLine(A27, A24)ZoomAllEnd Sub

В этой программе мы строим только линию 24-27, поскольку другие линии носят вспомогательный характер.
Файл с программой и необходимыми процедурами и функциями. bruki_01.zip Все процедуры и функции, используемые в этой программе, были описаны в предыдущих уроках.

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

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

Для того, чтобы линии, окружности, сплайны, дуги или другие объекты имели какой-либо цвет, требуется у этого объекта свойству color присвоить значение соответствующее нужному цвету.
Например, нужно писать объект.color=acRed для того, чтобы объект был красным.
Ниже приведен рисунок с названиями некоторых цветов.

Теперь рассмотрим пример построения квадрата, у которого каждая сторона имеет свой цвет.

Sub color() Dim A(0 To 2) As Double Dim B(0 To 2) As Double Dim C(0 To 2) As Double Dim D(0 To 2) As Double  A(0) = 10: A(1) = 10: A(2) = 0: B(0) = 30: B(1) = 10: B(2) = 0: C(0) = 10: C(1) = 30: C(2) = 0: D(0) = 30: D(1) = 30: D(2) = 0: Set lineobj = ThisDrawing.ModelSpace.AddLine(A, B) lineobj.color = acRed	'красный Set lineobj = ThisDrawing.ModelSpace.AddLine(B, D) lineobj.color = acGreen  'зеленый Set lineobj = ThisDrawing.ModelSpace.AddLine(C, D) lineobj.color = acBlue   'синий Set lineobj = ThisDrawing.ModelSpace.AddLine(A, C) lineobj.color = acYellow 'желтыйEnd Sub

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

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

Sub Layer() Dim A(0 To 2) As Double Dim B(0 To 2) As Double Dim C(0 To 2) As Double Dim D(0 To 2) As Double Dim layerObj As AcadLayer  ' Создаем четыре слоя с именами Side1, Side2, Side3, Side4 ' Каждому из слоев устанавливаем свой цвет Set layerObj = ThisDrawing.Layers.Add("Side1")  layerObj.color = acRed	'красный Set layerObj = ThisDrawing.Layers.Add("Side2")  layerObj.color = acGreen  'зеленый Set layerObj = ThisDrawing.Layers.Add("Side3")  layerObj.color = acBlue   'синий Set layerObj = ThisDrawing.Layers.Add("Side4")  layerObj.color = acYellow 'желтый  A(0) = 10: A(1) = 10: A(2) = 0: B(0) = 30: B(1) = 10: B(2) = 0: C(0) = 10: C(1) = 30: C(2) = 0: D(0) = 30: D(1) = 30: D(2) = 0: Set lineobj = ThisDrawing.ModelSpace.AddLine(A, B)  lineobj.Layer = "Side1" ' Переносим линию на слой Side1 Set lineobj = ThisDrawing.ModelSpace.AddLine(B, D)  lineobj.Layer = "Side2" ' Переносим линию на слой Side2 Set lineobj = ThisDrawing.ModelSpace.AddLine(C, D)  lineobj.Layer = "Side3" ' Переносим линию на слой Side3 Set lineobj = ThisDrawing.ModelSpace.AddLine(A, C)  lineobj.Layer = "Side4" ' Переносим линию на слой Side4End Sub

У нас добавилось четыре слоя, что можно видеть на следующем рисунке. Каждая из сторон квадрата имеет цвет того слоя, на котором находится.

[Цветы]

[/b]' Сама подпрограмма Dlina
Function Dlina(x1, y1, x2, y2) As Double
Dlina = Sqr((x1 - x2) ^ 2 + (y1 - y2) ^ 2)
End Function
[/i]
[attachmentid=26789

 

Если у нас допустим многоугольник (6 сторон и все равны значению ( а), то надо обязательно вычислять каждую сторону Допустим АВ,ВС,СМ и тд и подпрограммка (длина)меняется или остается такой же. Просто у меня не получилось построение Может даже я где-то сама сделала ошибку

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

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

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

Какие есть пожелания для следующих уроков? О чем бы вы хотели, чтобы я еще рассказала?

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

[Цветы]

_______1.zipДобрушанка я не нашла тему -(Точка пересечения 2-х линий и тема (Перечечение окружности с линией)
Без этой темы не построить линии которая задана пересечением

Изменено 3 октября, 2008 пользователем Цветы

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

Добрушанка я не нашла тему -(Точка пересечения 2-х линий)

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

' координаты точки пересечения двух прямыхSub peres_pr(AP1, BP1, CP1, AP2, BP2, CP2, x, y)Delta = AP1 * BP2 - BP1 * AP2If Delta = 0 Then  MsgBox "Ошибка. Точки пересечения не существует."  Else  x = -(CP1 * BP2 - BP1 * CP2) / Delta  y = -(AP1 * CP2 - CP1 * AP2) / DeltaEnd IfEnd Sub

А эта подпрограмма, которая находит точку пересечения отрезков

' координаты точки пересечения двух отрезков (x1,y1)-(x2,y2) и (x3,y3)-(x4,y4)Sub peres_otr(x1, y1, x2, y2, x3, y3, x4, y4, x, y)Call o_urav(x1, y1, x2, y2, AP1, BP1, CP1)Call o_urav(x3, y3, x4, y4, AP2, BP2, CP2)Call peres_pr(AP1, BP1, CP1, AP2, BP2, CP2, x, y)End Sub

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

[Цветы]

____________.zip

 

Неправильно видно записываю Посмотрите

[vadsura]

А есть русский хелп по вба у кого нить для автокада или корела на крайняк?

[ggpetrova]

Добрушанка,спасибо большое за уроки.Очень хочется еще узнать,как формочку для ввода сделать.
Я немного где-то надыбала еще вот что.
У объектов AcadLine,AcadCircle и т.д. есть метод IntersectWith
С его помощью можно найти пересечение объектов.

 

Неoбходимо объявить переменную
Dim intPoints As Variant
'Строим объекты

A5(0) = k1: A5(1) =k2: A5(2) =0
A4(0) =k3: A4(1) =k4: A4(2) = 0
A3(0)=k5:A3(1)=k6:A3(2)=0
Set line1 = doc.ModelSpace.AddLine(A4, A5)
r =12
Set cyrcle = doc.ModelSpace.AddCircle(A3, r))
intPoints = line1.IntersectWith(cyrcle, acExtendThisEntity)
'Ищем пересечение
If VarType(intPoints) <> vbEmpty Then
A6(0) = intPoints(0): A6(1) = intPoints(1): A6(2) = intPoints(2)
End If
точка A6 и есть пересечение
Как то так.

Изменено 8 октября, 2008 пользователем ggpetrova