Region и использование массивов в VBA

Markiza-2010 · 10.03.2010, 22:13

Здравствуйте, уважаемые форумчане! Помогите, пожалуйста, разобраться с массивами! Мне необходимо создать область (с помощью команды Region) в форме звезды, состоящей из неопределённого числа линий! Я запускаю код программы, а мне выводит ошибку: Method 'AddRedion' of object 'IAcadModelSpace' failed! Привожу ниже свой код программы!

Код:

[Выделить все]

Sub StarRegion()
 
Dim startPoint(0 To 2) As Double
Dim endPoint(0 To 2) As Double
Dim startPoint1(0 To 2) As Double
Dim endPoint1(0 To 2) As Double
 
Const p As Double = 3.141592654
Dim n As Integer
Dim i As Integer
Dim a As Integer
Dim k As Integer
Dim r1(0 To 2) As Double
Dim r2(0 To 2) As Double
Dim RotateAngle As Double
 
k = InputBox("Введите количество углов звёздочки", "Ввод данных", " ")
n = k * 2
a = 360 / n
r11 = 10
r22 = 20
RotateAngle = a
RotateAngle = RotateAngle * p / 180
 
Dim lineObj(0 To 21) As AcadEntity
 
For i = 1 To n
 
If (i Mod 2) = 1 Then
startPoint(0) = r11 * Cos(RotateAngle)
startPoint(1) = r11 * Sin(RotateAngle)
startPoint(2) = 0
endPoint(0) = r22 * Cos(RotateAngle + a * p / 180)
endPoint(1) = r22 * Sin(RotateAngle + a * p / 180)
endPoint(2) = 0
Set lineObj(i) = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
RotateAngle = RotateAngle + a * p / 180
 
ElseIf i = n Then
startPoint(0) = r22 * Cos(RotateAngle)
startPoint(1) = r22 * Sin(RotateAngle)
startPoint(2) = 0
endPoint(0) = r11 * Cos(a * p / 180)
endPoint(1) = r11 * Sin(a * p / 180)
endPoint(2) = 0
Set lineObj(i) = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
 
Else
startPoint(0) = r22 * Cos(RotateAngle)
startPoint(1) = r22 * Sin(RotateAngle)
startPoint(2) = 0
endPoint(0) = r11 * Cos(RotateAngle + a * p / 180)
endPoint(1) = r11 * Sin(RotateAngle + a * p / 180)
endPoint(2) = 0
Set lineObj(i) = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
RotateAngle = RotateAngle + a * p / 180
End If
 
Next i
Dim regionObj As Variant
regionObj = ThisDrawing.ModelSpace.AddRegion(lineObj)
 
Dim height As Double
Dim taperAngle As Double
height = 15
taperAngle = 0
 
Dim solidObj As Acad3DSolid
Set solidObj = ThisDrawing.ModelSpace.AddExtrudedSolid(regionObj(0), height, taperAngle)
 
End Sub

Заранее благодарна!

Олег (jr.) · 11.03.2010, 01:20

Попробуй попроще

Код:

[Выделить все]

Option Explicit
Option Base 0

Sub DrawGear()
Const pi As Double = 3.141592654

Dim util As AcadUtility
Dim opline As AcadLWPolyline
Dim cp(0 To 2) As Double
Dim n As Integer
Dim i As Integer
Dim j As Integer
Dim a As Double
Dim da As Double
Dim d As Double
Dim k As Integer
Dim r11 As Double
Dim r22 As Double

Set util = ThisDrawing.Utility

For i = 0 To 2
cp(i) = 0
Next

k = InputBox("Введите количество углов звёздочки", "Ввод данных", " ")

n = k * 2
a = pi * 2 / n
d = 0
da = a / 2
r11 = 10
r22 = 20

ReDim pts(0 To n * 2 - 1) As Double
For i = 0 To n - 1
Dim p
If i Mod 2 = 0 Then
p = util.PolarPoint(cp, d + a * i, r22)
Else
p = util.PolarPoint(cp, d + da + a * i, r11)
End If
pts(j) = CDbl(p(0)): pts(j + 1) = CDbl(p(1))
j = j + 2
Next

Set opline = ThisDrawing.ModelSpace.AddLightWeightPolyline(pts)
opline.Closed = True
Dim addobj(0) As AcadEntity
Set addobj(0) = opline
Dim regionObj As Variant
regionObj = ThisDrawing.ModelSpace.AddRegion(addobj)

Dim height As Double
Dim taperAngle As Double
height = 15
taperAngle = 0

Dim solidObj As Acad3DSolid
Set solidObj = ThisDrawing.ModelSpace.AddExtrudedSolid(regionObj(0), height, taperAngle)

regionObj(0).Delete
opline.Delete

End Sub

~'J'~

Alexey_02 · 11.03.2010, 02:06

А это ваш подправленный. В своем . . . . . лучше ориентироваться и яснее

(Мне в своем корявом тоже, чем в других кодах). Например, у Олег (jr.) он в VBA грамотный. Почитайте про динамический массив.

Код:

[Выделить все]

Option Explicit
Private Sub StarRegion()
Dim startPoint(0 To 2) As Double
Dim endPoint(0 To 2) As Double
'Dim startPoint1(0 To 2) As Double
'Dim endPoint1(0 To 2) As Double

Dim pi As Double
Dim n As Integer ' кол. сторон зезды
Dim i As Integer
Dim a As Integer
Dim k As Integer
'Dim r1(0 To 2) As Double
'Dim r2(0 To 2) As Double
Dim RotateAngle As Double
Dim r11 As Double ' радиус внутренних точек
Dim r22 As Double ' радиус внешних точек звезды
Dim lineObj() As AcadEntity ' (0 To 15) почему? тут нужен динамический массив т.к. мы не знаем сколько объектов

pi = 4 * Atn(1) ' Нахождение точного пи програмно
k = InputBox("Введите количество углов звёздочки", "Ввод данных", "8")
n = k * 2 ' Количенство сторон (линий) в звезде.
a = 360 / n
r11 = 10
r22 = 20
'Переопределяем динамический массив
ReDim lineObj(n - 1) 'т.е. говорим он будет состоять из стольки то сторон (линий) в звезде
' -1 т.к. нумерация массива с нуля.
'RotateAngle = a
'RotateAngle = RotateAngle * p / 180
RotateAngle = a * pi / 180

For i = 1 To n
If (i Mod 2) = 1 Then
    startPoint(0) = r11 * Cos(RotateAngle)
    startPoint(1) = r11 * Sin(RotateAngle)
    startPoint(2) = 0
    endPoint(0) = r22 * Cos(RotateAngle + a * pi / 180)
    endPoint(1) = r22 * Sin(RotateAngle + a * pi / 180)
    endPoint(2) = 0
    Set lineObj(i - 1) = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
    RotateAngle = RotateAngle + a * pi / 180

ElseIf i = n Then
    startPoint(0) = r22 * Cos(RotateAngle)
    startPoint(1) = r22 * Sin(RotateAngle)
    startPoint(2) = 0
    endPoint(0) = r11 * Cos(a * pi / 180)
    endPoint(1) = r11 * Sin(a * pi / 180)
    endPoint(2) = 0
    Set lineObj(i - 1) = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
    'Set lineObj(i) = ThisDrawing.ModelSpace.AddLine(lineObj(i - 1).startPoint, lineObj(i - 1).endPoint)
Else
    startPoint(0) = r22 * Cos(RotateAngle)
    startPoint(1) = r22 * Sin(RotateAngle)
    startPoint(2) = 0
    endPoint(0) = r11 * Cos(RotateAngle + a * pi / 180)
    endPoint(1) = r11 * Sin(RotateAngle + a * pi / 180)
    endPoint(2) = 0
    Set lineObj(i - 1) = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
    'Set lineObj(i) = ThisDrawing.ModelSpace.AddLine(lineObj(i - 1).startPoint, lineObj(i - 1).endPoint)
    RotateAngle = RotateAngle + a * pi / 180
End If

Next i

Dim regionObj As Variant '
regionObj = ThisDrawing.ModelSpace.AddRegion(lineObj)

Dim height As Double
Dim taperAngle As Double
height = 15
taperAngle = 0

Dim solidObj As Acad3DSolid
Set solidObj = ThisDrawing.ModelSpace.AddExtrudedSolid(regionObj(0), height, taperAngle)
End Sub

Внимание! Под Region (областью) еще остаются ваши линии.

Вот еще замечательная книга VBA в AutoCAD 2006, правда на английском, но лучше не видел

очень понравится тем, кто изучает VBA для AutocAD.

Кулик Алексей aka kpblc · 11.03.2010, 08:34

Alexey_02, пройдет пара месяцев, и твоя книжка опять кому-то понадобится. Ты не пробовал напрямую к посту подобную литературу прикреплять?

Alexey_02 · 11.03.2010, 15:35

Выложил в раздел Download / AutoCAD / Программирование / Книга
Хм. тут жму на ссылку - выхожу на книгу, а захожу через сайт Download -> AutoCAD -> Программирование. А там ее нет. В чем проблема?

Markiza-2010 · 11.03.2010, 17:43

Очень благодарна за ваши ответы! Спасибо за помощь!

Alexey_02 · 12.03.2010, 21:14

Кулик Алексей aka kpblc
Выложил ее в даунлоад - автокад - Программирование. Не знаю не нахожу ее там. Пропала или вообще не помстилась. раньше через поиск находил, сейчас нет. Черт знает что . Создал тему в разделе "разное" с описанием проблемы. Но там админ должен что ли одобрить ее для создаения. В общем не создали. Черт знает где задавать вопрос по форуму. Не разобрался. Залейте пожалуйста сами ее.

Кулик Алексей aka kpblc · 12.03.2010, 22:27

Я сказал - к посту, а не в download. Книги после 2005 года издания в download не допускаются.

Alexey_02 · 12.03.2010, 22:41

Если честно говоря. не понимаю

, наверное, лыжи не едут

Пост это сообщение, а как, где и к какому его клеить не понимаю. Сделайте пожалуйста сами. Я бы сделал, но не знаю как и где почитать на dwg что бы это сделать. Книга очень хорошая для тех кто собирается изучать VBA для AutoCAD. Хоть и на англ. языке. Заранее спасибо от всех кто будет пользоваться ей и от меня

.

Кулик Алексей aka kpblc · 12.03.2010, 23:38

http://forum.dwg.ru/showpost.php?p=262719&postcount=2

Alexey_02 · 13.03.2010, 01:19

Я как всегда в своем репертуаре

Век живи - век учись. Даже стыдно

Сделал, спасибо. Теперь буду знать.

AlexV · 13.03.2010, 20:08

Цитата:

Сообщение от Кулик Алексей aka kpblc

Я сказал - к посту, а не в download. Книги после 2005 года издания в download не допускаются.

Одна проблема, вложение к посту для архива максимум 10 метров, а книжка эта потянет небось на 150 минимум.. Разбивать архив, разве что..

Кулик Алексей aka kpblc · 13.03.2010, 22:50

Естественно - разбивать! Если количество архивов действительно безумное, то прошу в ПМ ко мне - обсудим детали.

Alexey_02 · 14.03.2010, 03:06

Стоп, стоп, стоп. Куда ее лепить. Я ее прилепил в 3 посте или где надо было? Она всего весит 5 метров.

Кулик Алексей aka kpblc · 14.03.2010, 20:08

Alexey_02, я отвечал на вопрос #12, и не более.

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Пароль к VBA	karp_b	Программирование	24	29.08.2013 12:43
Использование UserForm в VBA (AutoCAD)	Markiza-2010	Программирование	3	11.03.2010 23:44
Программирование для подшивок (VBA). Использование словарей	kp+	Программирование	1	21.11.2008 11:18
ActiveX Automation из VBA	karp_b	Программирование	5	14.09.2007 18:05