Сообщество программистов Autodesk в СНГ

ADN Club => VBA => Тема начата: Мурена от 14-11-2019, 09:18:19

Название: Добавление пользовательской системы координат
Отправлено: Мурена от 14-11-2019, 09:18:19
Здравствуйте !
Не получается добавить ПСК , параметры которой скопированы из уже имеющейся
Код - 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 добавляемой ПСК не перпендикуляры

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

Название: Re: Добавление пользовательской системы координат
Отправлено: Александр Ривилис от 14-11-2019, 10:15:08
Немножко сложнее:
Код - 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.  
Название: Re: Добавление пользовательской системы координат
Отправлено: Мурена от 14-11-2019, 10:42:24
Когда нолики и единички, всё устанавливается
Я хочу из одного чертежа в другой перекинуть пользовательские сохраненные ск. Но у них координаты не 0 и 1. Система ругается, что оси не перпендикулярны
Название: Re: Добавление пользовательской системы координат
Отправлено: Александр Ривилис от 14-11-2019, 11:18:39
Цитата: Мурена от 14-11-2019, 10:42:24
Когда нолики и единички, всё устанавливается
Я хочу из одного чертежа в другой перекинуть пользовательские сохраненные ск. Но у них координаты не 0 и 1. Система ругается, что оси не перпендикулярны
Вы мой код проверили?
Название: Re: Добавление пользовательской системы координат
Отправлено: Александр Ривилис от 14-11-2019, 11:52:54
Код - 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 и оси повёрнуты на произвольные углы).
Название: Re: Добавление пользовательской системы координат
Отправлено: Мурена от 14-11-2019, 12:04:47
Спасибо! Всё работает, неудачно заменила свой на ваш