[ТР5]

Смысл вопроса в след.Есть вагончик,на крыше которого распложено две антенны.Можно ли сделать лисп,с помощью которго мы сможем поворачивать вагончик,а антенны при этом будут смотреть в одну и ту же сторону,т.е. не будут менять своего первоначального направления,но остоваться при этом на своих местах относительно крыши вагона,т.е. чтобы на крыше они не меняли своих координат.

[Дима_]

Я думаю здесь поможет динамический блок.

[ТР5]

Дело в том что это нужно сделать в 2004 автокаде .

[Дима_]

Тогда блоком (программируй, не программируй) не получится.

[ТР5]

Может быть чертёж поможет объяснить то что я хочу.На нем нужно повернуть антенну из положения 1 в положение 2(к примеру)Но угол на который нужно повернуть вагон всегда разный и ориентация антенн тоже всегда разная.Сложность вся в том что если повернуть вагон,то соответственно ось поворота антенн тоже меняет своё положение.

[Владимир.]

Можно же прочитать у выбранного блока точку вставки?
Написать типа такого:
1. Выбираем блок-вагончик и поворачиваем вместе с антеннами на нужный угол вокруг точки вставки.
2. Выбираем и поворачиваем блок - каждую антенну вокруг точек вставки на тот же угол в обратном направлении.

[Do$]

Насколько я помню, в 2004 есть ActiveX.
На пробу:

Код:

[Выделить все]

(defun c:vagon (/
  _dwgru-conv-pickset-to-list
  _dwgru-property-get
  _dwgru-conv-ent-to-vla
  all_rot_set
  mov_set
  mov_set_lst
  ent_rot_lst
        )
  (defun _dwgru-conv-pickset-to-list (value / tab item)
    (repeat (setq tab  nil
    item (sslength value)
     ) ;_ end setq
      (setq tab (cons (ssname value (setq item (1- item))) tab))
    ) ;_ end repeat
  ) ;_ end defun
  (defun _dwgru-conv-ent-to-vla (ent)
    ;|
*    Выполняет преобразование переданного указателя в vlax-вариант
*    Параметры вызова:
 ent обрабатываемый указатель. Может быть:
   ename
   vla-object
   строка (воспринимается как хендл примитива).
*    Примеры вызова:
(setq entity (entmakex (list (cons 0 "POINT") (cons 10 (getpoint)))))
(_dwgru-conv-ent-to-vla entity) ; #<VLA-OBJECT IAcadPoint 064ad294>
|;
    (cond
      ((= (type ent) 'vla-object) ent)
      ((= (type ent) 'ename) (vlax-ename->vla-object ent))
      ;|
;; Оригинальный вариант:
((= (type ent) 'str) (vlax-ename->vla-object (handent ent)))
|;
      ;; Исправления Alaspher от 28.11.2007. Начало.
      ((= (type ent) 'str)
       (if (setq ent (handent ent))
  (vlax-ename->vla-object ent)
       ) ;_ end of if
      )
      ;; Исправления Alaspher от 28.11.2007. Конец
      (t nil)
    ) ;_ end of cond
  ) ;_ end of defun
  (defun _dwgru-property-get (obj prop)
        ;|
*    Получение значения свойства объекта.
*    Параметры вызова:
 obj указатель на объект. Допускается применение ename, vla, строки
  (в последнем случае воспринимается как хендл объекта)
 prop имя свойства. Может быть строкой или атомом
*    Возвращает значение указанного свойства. Если свойства у объекта нет,
* возвращает nil.
*    Примеры вызова:
(_dwgru-property-get (vla-get-ActiveDocument (vlax-get-acad-object)) 'activelayer)
 ; #<VLA-OBJECT IAcadLayer2 064b04e4>
(_DWGRU-PROPERTY-GET (vla-get-ActiveDocument (vlax-get-acad-object)) 'layer)
 ; nil
|;
    (if (and (setq obj (_dwgru-conv-ent-to-vla obj))
      (vlax-property-available-p obj prop)
 ) ;_ end of and
      (vlax-get-property obj prop)
    ) ;_ end of if
  ) ;_ end of defun

  (vl-load-com)
  (cond
    ((/= (type
    (setq all_rot_set
    (vl-catch-all-apply
      (function
        (lambda ()
   (prompt "\nВыберите объекты для вращения:")
   (ssget)
        ) ;_ end of lambda
      ) ;_ end of function
    ) ;_ end of vl-catch-all-apply
    ) ;_ end of setq
  ) ;_ end of type
  (quote pickset)
     ) ;_ end of =
     (if (not all_rot_set)
       (prompt "\nНичего не выбрано!")
     ) ;_ end of if
    )
    ((/= (type
    (setq
      mov_set
       (vl-catch-all-apply
  (function
    (lambda ()
      (prompt
        "\nУкажите блоки, которые не меняют угол поворота:"
      ) ;_ end of prompt
      (ssget '((0 . "INSERT")))
    ) ;_ end of lambda
  ) ;_ end of function
       ) ;_ end of vl-catch-all-apply
    ) ;_ end of setq
  ) ;_ end of type
  (quote pickset)
     ) ;_ end of =
     (if (not mov_set)
       (prompt "\nНичего не выбрано!")
     ) ;_ end of if
    )
    ((not
       (vl-some (function (lambda (m) (ssmemb m all_rot_set)))
  (setq mov_set_lst (_dwgru-conv-pickset-to-list mov_set))
       ) ;_ end of vl-some
     ) ;_ end of not
     (prompt
       "\nВыбранные блоки не входят в объекты для вращения!"
     ) ;_ end of prompt
    )
    (T
     (setq ent_rot_lst
     (mapcar
       (function
  (lambda (ent)
    (cons ent
   (_dwgru-property-get ent "Rotation")
    ) ;_ end of cons
  ) ;_ end of lambda
       ) ;_ end of function
       mov_set_lst
     ) ;_ end of mapcar
     ) ;_ end of setq
     (vl-cmdf "_.Rotate" all_rot_set "")
     (if (while (and (= (getvar "cmdactive") 1)
       ;;(= (getvar "cmdnames") "ROTATE")
  ) ;_ end of and
    (vl-cmdf pause)
  ) ;_ end of while
       (foreach ent_rot ent_rot_lst
  (vla-put-Rotation
    (_dwgru-conv-ent-to-vla (car ent_rot))
    (cdr ent_rot)
  ) ;_ end of vla-put-Rotation
       ) ;_ end of foreach
     ) ;_ end of if
    )
  ) ;_ end of cond
  (princ)
) ;_ end of defun

[ТР5]

Спасибо вам Do$.Опробывал вашу программку работает гораздо лучше чем мой макрос
*^C^C_-insert;вагон;\;;\_explode;last;_id;\_cal;p1=@;_id;\_cal;p2=@;_rotate;\;\'cal;-ang(p1,p2);_rotate;\;\'cal;-ang(p1,p2);

[Do$]

Пожалуйста!
А макрос в LT пригодится