Адаптация lisp. AttRotate

[doctorraz]

В АК крутит атрибуты в ноль по ПСК, по объекту и на произвольный угол...

В НК на произвольный угол не умеет.

Посмотрите пожалуйста, кто разбирается.. может можно починить?

 

AttrRot.lsp

Edited March 10 by doctorraz

[EdwardSt]

У меня в загрузках остался этот лисп с предыдущих обсуждений. 

Мой коммент нашелся тут 

 

Сейчас могу только повторить, что воспроизвести динамику (визуализацию произвольного поворота) в NC не удается.

Если это не принципиально и достаточно просто запроса произвольного угла, то преобразовать можно.

Чуть позже подпилю, если есть необходимость или кто-то не сделает это раньше.

 

 

 

[doctorraz]

24 минуты назад, EdwardSt сказал:

Если это не принципиально и достаточно просто запроса произвольного угла, то преобразовать можно.

думаю этого будет вполне достаточно

[kpblc]

В первом приближении получилось нечто типа

;;cadhelp 1999-2003
;;Rotate attributes
;;Multy select // code line 12
;;Rotate by selected attr's by chsen obj (line,pline,arc,text,attr )code line 81
;;Or dinamic or 0 
          ; (defun C:AtR ( / att NewAngle Bpoint ed basePoint ss GlobalOsnap opt ent i) 
(defun c:atr (/ att newangle bpoint ed basepoint ss globalosnap opt ent i)
  (setq ss (ssadd))
  (setq globalosnap (getvar "OSMODE"))
  (setvar "OSMODE" 0)

  (while (setq att (car (nentsel "\nSelect Attributes to rotate")))
    (redraw att 3)
    (setq lastent att)
    (setq ss (ssadd att ss))
    (princ "\n ")
    (princ (sslength ss))
    (princ " selected.")
  ) ;_ end of while

  ;;(if (not basePoint)  ;; araound block insert point
  ;;	  (setq basePoint(dxf 10(entget(dxf 330 (entget lastEnt)))))
  ;;)
  (if (assoc 11 (entget lastent))
    ;; around adjastment point of attribute
    (setq basepoint (dxf 11 (entget lastent)))
    (setq basepoint (dxf 10 (entget lastent)))
  ) ;_ end of if

  (setq newangle (getangle "\nSpecify angle :"))

  (setq i 0)
  (while (setq ent (ssname ss i))
    (redraw ent 4)
    (setq ed (entget ent))
    (setq ed (subst (cons 50 newangle) (assoc 50 ed) ed))
    (entmod ed)
    (entupd ent)
    (setq i (+ i 1))
  ) ;_ end of while
  (setvar "OSMODE" globalosnap)
  (prompt "")
) ;_ end of defun

(defun dinamicrotate (ss / ss sstemp p1 p2 code i ent ed)
  (command "_.UNDO" "_BEGIN")
  (defun *error* (msg / olderror)
    (doundo)
    (princ msg)
    (setq *error* nil)
  ) ;_ end of defun
  (defun doundo (/ ent i)
    (command "_UNDO" "_END")
    (command "_U" "")
    (redraw)
    (setq i 0)
    (while (setq ent (ssname ss i))
      (redraw ent 4)
      (setq i (+ i 1))
    ) ;_ end of while
  ) ;_ end of defun
  (progn

    (princ "\nRelative rotate")
    (setq sstemp (ssadd))
    (if (equal (setq p1 (dxf 11 (entget (ssname ss 0)))) '(0 0 0))
      (setq p1 (dxf 10 (entget (ssname ss 0))))
    ) ;_ end of if
    (princ "\nSpecify Angle:")
    (setq code 0)
  ) ;_ end of progn
  ;;progn
  (while (/= code 3)
    (progn
      (setq code (car (setq p2 (grread t))))
      (redraw)
      (setq p2 (cadr p2))
      (setq i 0)
      ;;(sserase ssTemp)
      (setq sstemp (ssadd))
    ) ;_ end of progn
    ;;progn
    (while (setq ent (ssname ss i))
      (setq ed (entget ent))
      ;;(if ent1 (entdel ent1))
      (grdraw p1 p2 7 1)
      (setq ang (angle p1 p2))
      (setq ed (subst (cons 50 ang) (assoc 50 ed) ed))
      (entmod ed)
      (entupd ent)
      ;;(setq ent1 (entlast))
      (setq sstemp (ssadd (entlast) sstemp))
      (setq i (1+ i))
    ) ;_ end of while
  ) ;_ end of while
  ;;(sserase ssTemp)
  (doundo)
  (redraw)
  ang
) ;_ end of defun
(defun dxf (number ed /) (cdr (assoc number ed))) ;defun
          ; (AtR pause " " " ")

Тут еще можно многое вычистить и поменять, но мне пока не до того ((

добавлено через 2 минуты

Спойлер

Если честно, я бы переписывал с нуля

 

[kpblc]

Альтернатива. Не факт, что я правильно понял задачу, так что прошу сильно не бить )))

(vl-load-com)
(defun c:atr2 (/ adoc elist ent ang)
  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  (while (= (type
              (setq ent (vl-catch-all-apply (function (lambda () (car (nentsel "\nSelect attribute reference <Stop> : "))))))
            ) ;_ end of type
            'ename
         ) ;_ end of =
    (if (/= (cdr (assoc 0 (entget ent))) "ATTRIB")
      (princ "\nIt's not an ATTRIB")
      (setq elist (cons ent elist))
    ) ;_ end of if
  ) ;_ end of while
  (if (and elist
           (= (type
                (setq ang (vl-catch-all-apply (function (lambda () (getangle "\nSpecify angle <Cancel> : ")))))
              ) ;_ end of type
              'real
           ) ;_ end of =
      ) ;_ end of and
    (progn
      (foreach item (mapcar
                      (function entget)
                      elist
                    ) ;_ end of mapcar
        (vl-catch-all-apply
          (function
            (lambda ()
              (entmod (subst (cons 50 ang) (assoc 50 item) item))
            ) ;_ end of lambda
          ) ;_ end of function
        ) ;_ end of vl-catch-all-apply
      ) ;_ end of foreach
    ) ;_ end of progn
  ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
) ;_ end of defun

На работе приложить файл не получается - "безопасность" аднака...

[doctorraz]

8 минут назад, kpblc сказал:

Альтернатива

почти!!!

[kpblc]

Ну, "по объекту" не буду делать - мне кажется, что вручную указать две точки приведет к более предсказуемому результату Или что-то еще упустил?

[doctorraz]

8 минут назад, kpblc сказал:

Или что-то еще упустил?

ПСК!=МСК, в аттаче пример

-------------

В МСК то, что надо

ПСК not МСК.dwg

добавлено через 1 минуту

14 минут назад, kpblc сказал:

указать две точки приведет к более предсказуемому результату

да!

[kpblc]

Т.е. ты хочешь, чтобы атрибуты поворачивались в текущей СК, а не в ОСК?

[doctorraz]

13 минут назад, kpblc сказал:

Т.е. ты хочешь, чтобы атрибуты поворачивались в текущей СК, а не в ОСК?

Ну нормальное ж желание

В пск, вид сверху, режим орто

Показываю поворот по орто, а атрибут встает орто но по МСК, т.е. в этой ПСК под углом.

 

------------

В исходнике подозреваю для этого сделан режим по объекту

Строю отрезок орто в ПСК и по нему ровняю атрибуты..

--------------

Хотя в нано сами разработчики плавают в ПСК, судя по недавней теме с выносками (в смысле вполне возможно, что местами сам движок не везде корректно отрабатывает)

Edited March 10 by doctorraz

[doctorraz]

Поигрался немного..

Как по мне стало удобнее чем было, Спасибо!

Фиг с ней с этой пск

[kpblc]

Отрезок если что - для него понятия "ОСК" (равно как и дл точки) - не существует. Можно менять 210 группу как угодно - ситуация не изменится. А так чисто теоретически можно было бы попытаться использовать системные переменные ucsxdir, ucsydir, перемножить соответствующие вектора, получить нормаль для текущей СК, и вместе с 50 группой менять еще и 210. Но результат (подозреваю) будет аховый. Особенно когда атрибуты улетать начнут

[EdwardSt]

14 минут назад, kpblc сказал:

Отрезок если что - для него понятия "ОСК" (равно как и дл точки) - не существует. Можно менять 210 группу как угодно - ситуация не изменится.

Тем не менее, 210 группа - это одна из  зацепок, в соответствии с которой можно определять оси Z для поворота.

Хотя более логичным выглядит вариант с использованием оси Zтекущей  ПСК и проекцией объекта (в том числе и отрезка) на текущую же XOY.

 

Кстати, не совсем в тему, но 210 группа оказалась довольно важна.

Года 2 назад была ветка на по данной тематике.

Например, два отрезка, лежащие в плоскости XOY и имеющие общую конечную точку, но имеющие различные 210 группы, не удается собрать в полилинию.

Почему так - ответа добиться не удалось. 

[kpblc]

Небольшой прикол про 210 группу

При работе в ACAD: вставил любой блок в МСК; создал новую ПСК, просто смещая базовую точку системы координат (направление осей не менялось); вставляю второй блок. 210 группа будет одинакова. Но если в блоке будет поле, связанное, к примеру, со значением точки вставки блока по Y, то в первом оно будет высчитываться от нуля МСК, а во втором- от нуля ПСК. Магия

Ось Z для текущей системы координат, особенно если она не именована, получить (насколько я помню) не удастся - понадобится использовать именно ucsxdir / ucsydir и на их основе что-то вычислять. А потом понадобится менять 210 группу у атрибутов, точки вставки, точки выравнивания, потом еще и мнгострочные атрибуты нарисуются - в общем, многовато действий ИМХО.

[doctorraz]

Фиг с ней с ориентацией по ПСК, эт я еще по Z не экспериментировал.. там ваще ой получится, с другой стороны никому это не надо.. если только академический интерес

Но если добавить ориентацию по объекту... ПСК можно не высчитывать..)))

Но ктожэж мне запретмт  оба лиспа пользовать...

Еще раз спасибо!!!, 

быстрее стали вопросы решаться.. ещеб нанодев в этот темп подтянуть, ваще красота будет

 

[kpblc]

Спойлер

Да просто по шарпам буксую, по автообновлениям меню в NC - тоже полные тормоза, вот и развлекаюсь ))

 

[doctorraz]

2 минуты назад, kpblc сказал:

Да просто по шарпам буксую

Все тоже самое как и в АК

добавлено через 7 минут

4 минуты назад, kpblc сказал:

по автообновлениям меню в NC - тоже полные тормоза,

Если без перезапуска НК меню,  миссия невыполнима, умеет только ленту обновлять

-----

Тыб тему в программировании сделал, чего не получается/интересует..

Разработчики бывают частенько и дают ценные советы

[doctorraz]

11 минут назад, kpblc сказал:

вот и развлекаюсь ))

Развлечение с пользой, для меня так точно))

Чот мысля в голову пришла.. тулпаки ж всяки разные для всего делают.. 

Подумал чего для наны не собрать...

Кто не умеет в футбол идет в тренеры)))