| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > VBA и система координат

VBA и система координат

Ответ
Поиск в этой теме
Непрочитано 10.12.2003, 10:29 #1
VBA и система координат
Ра
 
Сообщений: n/a

У меня возникли проблемы с переносом системы координат.
Запускаю процедуру черчу деталь переношу 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

[email protected]
Просмотров: 6131
 
Непрочитано 10.12.2003, 10:44
#2
{Smirnoff}

Инженер по системам безопасности
 
Регистрация: 23.11.2003
Рига
Сообщений: 1,099


Думаю что в конце Set plineObj = Nothing.
{Smirnoff} вне форума  
 
Непрочитано 10.12.2003, 15:33 для Fantomas
#3
Ра


 
Сообщений: n/a


Уважаемый Fantomas!
Не помогло.
 
 
Непрочитано 10.12.2003, 17:40
#4
{Smirnoff}

Инженер по системам безопасности
 
Регистрация: 23.11.2003
Рига
Сообщений: 1,099


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

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск