Добавление пользовательской системы координат

[Мурена]

Здравствуйте !
Не получается добавить ПСК , параметры которой скопированы из уже имеющейся

Код - Visual Basic [Выбрать]

1.  Dim userUCS As IAcadUCS
2.  Set userUCS = ThisDrawing.UserCoordinateSystems("123")
3.  ThisDrawing.UserCoordinateSystems.Add(userUCS.origin, userUCS.XVector, userUCS.YVector, "New_UCS")

Ошибка - оси X и Y добавляемой ПСК не перпендикуляры

Кто сталкивался, посоветуйте решение

[Александр Ривилис]

Немножко сложнее:

Код - Visual Basic [Выбрать]

1. Sub Test()
2.     Dim CurrentUCS As AcadUCS, NewUCS As AcadUCS
3.     Dim orig() As Double, xvec() As Double, yvec() As Double
4.     Dim xpnt(0 To 2) As Double, ypnt(0 To 2) As Double
5.     Set CurrentUCS = ThisDrawing.UserCoordinateSystems("123")
6.     orig = CurrentUCS.Origin
7.     xvec = CurrentUCS.XVector
8.     yvec = CurrentUCS.YVector
9.     xpnt(0) = orig(0) + xvec(0)
10.     xpnt(1) = orig(1) + xvec(1)
11.     xpnt(2) = orig(2) + xvec(2)
12.     ypnt(0) = orig(0) + yvec(0)
13.     ypnt(1) = orig(1) + yvec(1)
14.     ypnt(2) = orig(2) + yvec(2)
15.     Set NewUCS = ThisDrawing.UserCoordinateSystems.Add(orig, xpnt, ypnt, "New_UCS")
16.  
17. End Sub
18.  

[Мурена]

Когда нолики и единички, всё устанавливается
Я хочу из одного чертежа в другой перекинуть пользовательские сохраненные ск. Но у них координаты не 0 и 1. Система ругается, что оси не перпендикулярны

[Александр Ривилис]

Когда нолики и единички, всё устанавливается
Я хочу из одного чертежа в другой перекинуть пользовательские сохраненные ск. Но у них координаты не 0 и 1. Система ругается, что оси не перпендикулярны

Вы мой код проверили?

[Александр Ривилис]

Код - Visual Basic [Выбрать]

1. Sub CopyUCS123()
2.     Dim DOC1 As AcadDocument
3.     Dim CurrentUCS As AcadUCS, NewUCS As AcadUCS
4.     Dim orig() As Double, xvec() As Double, yvec() As Double
5.     Dim xpnt(0 To 2) As Double, ypnt(0 To 2) As Double
6.     Set CurrentUCS = ThisDrawing.UserCoordinateSystems("123")
7.     orig = CurrentUCS.Origin
8.     xvec = CurrentUCS.XVector
9.     yvec = CurrentUCS.YVector
10.     xpnt(0) = orig(0) + xvec(0)
11.     xpnt(1) = orig(1) + xvec(1)
12.     xpnt(2) = orig(2) + xvec(2)
13.     ypnt(0) = orig(0) + yvec(0)
14.     ypnt(1) = orig(1) + yvec(1)
15.     ypnt(2) = orig(2) + yvec(2)
16.     Set DOC1 = Documents.Add
17.    
18.     Set NewUCS = DOC1.UserCoordinateSystems.Add(orig, xpnt, ypnt, "123")
19.    
20. End Sub

Вот так я создаю копию UCS в другом документе. Работает с произвольной UCS (начало не в 0,0,0 и оси повёрнуты на произвольные углы).

[Мурена]

Спасибо! Всё работает, неудачно заменила свой на ваш