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

ADN Club => AutoLisp / VisualLISP и DCL => Тема начата: Балиев от 30-07-2016, 17:25:23

Название: Создать новую UCS.
Отправлено: Балиев от 30-07-2016, 17:25:23
Как программно создать новую UCS? Может есть функция аналогичная команде "UCS"?

Заранее благодарен.
Название: Re: Создать новую UCS.
Отправлено: Александр Ривилис от 30-07-2016, 17:26:52
Балиев
Я правильно понимаю, что речь идёт о VisualLisp?
Название: Re: Создать новую UCS.
Отправлено: Александр Ривилис от 30-07-2016, 18:04:52
На основе примера из документации:

Код - Auto/Visual Lisp [Выбрать]
  1. (defun c:ADDUCS( / acadObj doc origin xAxisPnt yAxisPnt UCSs ucsobj)
  2.     (vl-load-com)
  3.     (setq acadObj (vlax-get-acad-object))
  4.     (setq doc (vla-get-ActiveDocument acadObj))
  5.     ;; Создаём ПСК с именем "Моя_ПСК"
  6.  
  7.     ;; Определяем ПСК
  8.     (setq origin (vlax-3d-point 4 5 3)
  9.           xAxisPnt (vlax-3d-point 5 5 3)
  10.           yAxisPnt (vlax-3d-point 4 6 4))
  11.  
  12.     ;; Добавляем ПСК в коллекцию ПСК
  13.     (setq UCSs (vla-get-UserCoordinateSystems doc))
  14.     (setq ucsObj (vla-Add UCSs origin xAxisPnt yAxisPnt "Моя_ПСК"))
  15.     (alert (strcat (vla-get-Name ucsObj) " добавлена."
  16.                     "\nНачало координат: "
  17.                                  (rtos (vlax-safearray-get-element
  18.                                     (vlax-variant-value (vla-get-Origin ucsObj)) 0) 2) ", "
  19.                                  (rtos (vlax-safearray-get-element
  20.                                     (vlax-variant-value (vla-get-Origin ucsObj)) 1) 2) ", "
  21.                                  (rtos (vlax-safearray-get-element
  22.                                     (vlax-variant-value (vla-get-Origin ucsObj)) 2) 2)
  23.                     "\nОсь X: "
  24.                                  (rtos (vlax-safearray-get-element
  25.                                     (vlax-variant-value (vla-get-xVector ucsObj)) 0) 2) ", "
  26.                                  (rtos (vlax-safearray-get-element
  27.                                     (vlax-variant-value (vla-get-xVector ucsObj)) 1) 2) ", "
  28.                                  (rtos (vlax-safearray-get-element
  29.                                     (vlax-variant-value (vla-get-xVector ucsObj)) 2) 2)
  30.                     "\nОсь Y: "
  31.                                  (rtos (vlax-safearray-get-element
  32.                                     (vlax-variant-value (vla-get-yVector ucsObj)) 0) 2) ", "
  33.                                  (rtos (vlax-safearray-get-element
  34.                                     (vlax-variant-value (vla-get-yVector ucsObj)) 1) 2) ", "
  35.                                  (rtos (vlax-safearray-get-element
  36.                                     (vlax-variant-value (vla-get-yVector ucsObj)) 2) 2)
  37.  
  38.            )
  39.     )  
  40. )

Название: Re: Создать новую UCS.
Отправлено: Балиев от 30-07-2016, 18:29:14
Балиев
Я правильно понимаю, что речь идёт о VisualLisp?
Да, конечно.