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

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


Private Sub cmdDrawDucts_Click()

Dim ucsObj1 As AcadUCS
Dim origin(0 To 2) As Double
Dim xAxisPoint(0 To 2) As Double
Dim yAxisPoint(0 To 2) As Double

origin(0) = 2: origin(1) = 2: origin(2) = 0
xAxisPoint(0) = 3: xAxisPoint(1) = 2: xAxisPoint(2) = 0
yAxisPoint(0) = 2: yAxisPoint(1) = 3: yAxisPoint(2) = 0

Set ucsObj1 = ThisDrawing.UserCoordinateSystems.Add(origin, xAxisPoint, yAxisPoint, "UCS0")
ThisDrawing.ActiveUCS = ucsObj


Dim plineObj As AcadPolyline 'Объявляем переменную полилиния
Dim dWidth As Double 'Объявляем переменную "Ширина"
Dim dHeight As Double 'Объявляем переменную "Высота"
Dim points(0 To 11) As Double 'Объявляем переменную "точки" с 1-й по 4-ю координат полилинии

dWidth = CDbl(txtWidth.Text) 'Присваиваем переменной число из техтового бокса Ширина
dHeight = CDbl(txtHeight.Text) 'Присваиваем переменной число из техтового бокса Высота

' Определяем четыре двухмерные точки полилинии и рисуем п образный прямоугольник
points(0) = 0: points(1) = 0: points(2) = 0 'Определяем первую левую нижнюю точку
'по координатам X,Y,Z
points(3) = 0: points(4) = dHeight: points(5) = 0 'Определяем вторую левую верхнюю точку
'по координатам X,Y,Z
points(6) = dWidth: points(7) = dHeight: points(8) = 0 'Определяем третью правую верхнюю точку
'по координатам X,Y,Z
points(9) = dWidth: points(10) = 0: points(11) = 0 'Определяем четвёртую правую нижнюю точку
'по координатам X,Y,Z

' Создаём п образный контур полилинии в пространстве модели
Set plineObj = ThisDrawing.ModelSpace.AddPolyline(points)

' Присваиваем своиству полилинии "closed" статус "True"-истиный
' и тем самым замыкаем прямоугольник
plineObj.Closed = True
ThisDrawing.Regen (True)



Dim dLenght As Double 'Объявляем переменную "Длинна"

dLenght = CDbl(txtLenght.Text) 'Присваиваем переменной число из текстового бокса Длина

plineObj.Thickness = 0 'Придаём полилинии толщину по оси Z на величину из текстового бокса Длина


ZoomAll



'Переносим систему координат

Dim ucsObj As AcadUCS
Dim origin(0 To 2) As Double
Dim xAxisPoint(0 To 2) As Double
Dim yAxisPoint(0 To 2) As Double

origin(0) = points(0): origin(1) = points(1): origin(2) = dLenght
yAxisPoint(0) = points(3): yAxisPoint(1) = points(4): yAxisPoint(2) = dLenght
xAxisPoint(0) = points(9): xAxisPoint(1) = points(11): xAxisPoint(2) = dLenght

Set ucsObj = ThisDrawing.UserCoordinateSystems.Add(origin, xAxisPoint, yAxisPoint, "UCS1")

ThisDrawing.ActiveUCS = ucsObj


ThisDrawing.Regen True





End Sub

rbsk@list.ru

[{Smirnoff}]

Думаю что в конце Set plineObj = Nothing.

Уважаемый Fantomas!
Не помогло.

[{Smirnoff}]

Сам к сожалению начинающий. Я тут уже отсылал народ на www.autocad.ru (думаю к неудовольствию Perezz!!). Но думаю что это одно из немногих мест где реально (но далеко не всегда помогают) могут помочь по VBA. Короче попробуй, там отдельная ветка по VBA на форуме. С моим последним вопросом никто ни тут ни там не помог.