Тема: Поворот атрибутов блока

Задача следующая (как подступиться, даже не представляю): есть блок с некоторым количеством атрибутов (видимые, не Constant). Естественно, что в момент вставки блока производится его поворот. Но следом и атрибуты поворачиваются. Как лиспом (именно им) программно повернуть все атрибуты текущего блока в горизонт?
Количество атрибутов переменное - может достигать до 5 штук. При этом функция не должна трогать уже вставленные блоки (даже с таким же именем). Вариант _-attedit не катит - пользователь не должен ничего выбирать и не должен ни на что щелкать.
И как бонус:
В общем случае (если тэги известны) можно было бы дополнительно в качестве входящего параметра указывать список атрибутов с углами поворота, например:

(list (cons "Tag1" 0.0) (cons "Tag2" 15.0) (cons "Tag3" nil))

- только думаю, что это нереально.
И если угол nil, то поворачивать следом за блоком. Если нет - то на указанный угол для текущей USC. Угол указывается в единицах чертежа.
Есть идеи? Хотя бы на первую часть? (надеюсь, понятно рассказал, чего хочу)

Re: Поворот атрибутов блока

Так можно

(defun kpblc-attr-hor (block)
    (foreach x
               (vlax-safearray->list
                   (vlax-variant-value
                       (vla-GetAttributes
                           (vlax-ename->vla-object block)
                       )
                   )
               )
        (vla-put-rotation x 0)
    )
) 

Re: Поворот атрибутов блока

> AY
Класс! А для второго варианта уже не так просто, я так полагаю? Если лень, то и ладно, бог с ним - мне и это счастье доставит.

Re: Поворот атрибутов блока

> kpblc
Самое смешное, что я решал для себя эту же
проблему где-то полгода назад и решил ее точно
также как AY, хотел было уже послать, но нарвался
на глюк:
у меня в блоке один из атрибутов - постоянный.
То ли из-за этого, то ли еще из-за чего, но
поворачивается вслед за атрибутами и сам блок
Так что есть над чем подумать...
~'O'~

Re: Поворот атрибутов блока

> kpblc
Удовольствие поиска глюко-багов, а также проверку на замороженность слоев оставляю вам.
По пожеланию Олега постоянные и невидимые атрибуты не обрабатываются.
Предполагается, что углы в списке указаны в градусах.

(defun kpblc-attr-rot (block ang-list / ang)
 ;block -имя примитива
 ;ang-list -список типа '(("STROKA_1" . 30 )  ("STROKA_2" . 60 ) ("STROKA_3" . 90 ))
    (foreach x
               (vlax-safearray->list
                   (vlax-variant-value
                       (vla-GetAttributes
                           (setq block (vlax-ename->vla-object block))
                       ) ;_ vla-GetAttributes
                   ) ;_ vlax-variant-value
               ) ;_ vlax-safearray->list
        (cond ((= (vla-get-invisible x) :vlax-true))
              ((=(vla-get-Constant x) :vlax-true))
              ((setq ang (assoc (vla-get-TagString x) ang-list))
               (if (cdr ang)
                   (vla-put-rotation x (* (cdr ang) (/ pi 180)))
                   (vla-put-rotation x (vla-get-rotation block))
               ) ;_ if
              )
              (t
               (vla-put-rotation
                   x
                   (* (/ (angle (trans '(0.0 0.0) 1 0)
                                (trans '(1.0 0.0) 1 0)
                         ) ;_ angle
                         pi
                      ) ;_ /
                      180
                   ) ;_ *
               ) ;_ vla-put-rotation
              )
        ) ;_ cond
    ) ;_ foreach
) ;_ defun
;;;пример вызова
(kpblc-attr-rot    (car (entsel))
    '(("STROKA_1" . 30) ("STROKA_2" . 60) ("STROKA_3" . 90) ("STROKA_4" . nil))
) ;_ kpblc-attr-hor

Re: Поворот атрибутов блока

Cool!
У меня нет слов :)
Можно закидывать в "Готовые программы"?

Re: Поворот атрибутов блока

> kpblc
Потестируй, добавь проверку на слои и выкладывай если хочешь. Впрочем задача довольно специализированна и вряд-ли кому пригодится.

Re: Поворот атрибутов блока

> AY
Два раза cool!
~'O'~

Re: Поворот атрибутов блока

> AY
Мне кажется, что в эту часть кода вкралась ошибка:

(vla-put-rotation
                   x
                   (* (/ (angle (trans '(0.0 0.0) 1 0)
                                (trans '(1.0 0.0) 1 0)
                         ) ;_ angle
                         pi
                      ) ;_ /
                      180
                   ) ;_ *
               ) ;_ vla-put-rotation

Угол получится в градусах...

Re: Поворот атрибутов блока

> Александр Ривилис
Так в градусах и надо, я лучше перед передачей параметров проанализирую все в списке буду передавать градусы ;)
Или не все так просто? Дело в том, что ActiveX-функции... немного я их не понимаю (надеюсь, пока)

Re: Поворот атрибутов блока

> Александр Ривилис
Это меня шибко хвалили и сглазили :)
Исправляюсь и добавляю проверку на "слои".

(defun kpblc-attr-rot (block ang-list / ang)
 ;block -имя примитива
 ;ang-list -список типа '(("STROKA_1" . 30 )  ("STROKA_2" . 60 ) ("STROKA_3" . 90 ))
    (foreach x
               (vlax-safearray->list
                   (vlax-variant-value
                       (vla-GetAttributes
                           (setq block (vlax-ename->vla-object block))
                       )
                   )
               )
        (cond ((= (vla-get-invisible x) :vlax-true))
              ((= (vla-get-Constant x) :vlax-true))
              ((= (vla-get-lock
                      (vla-item (vla-get-layers
                                    (vla-get-activedocument
                                        (vlax-get-acad-object)
                                    )
                                )
                                (vla-get-layer x)
                      )
                  )
                  :vlax-true
               )
              )
              ((setq ang (assoc (vla-get-TagString x) ang-list))
               (if (cdr ang)
                   (vla-put-rotation x (* (cdr ang) (/ pi 180)))
                   (vla-put-rotation x (vla-get-rotation block))
               ) ;_ if
              )
              (t
               (vla-put-rotation
                   x
                   (angle (trans '(0.0 0.0) 1 0)
                          (trans '(1.0 0.0) 1 0)
                   ) ;_ angle
               )
              )
        ) ;_ cond
    ) ;_ foreach
) ;_ defun
;;пример вызова
(kpblc-attr-rot
    (car (entsel))
    '(("STROKA_1" . 30)
      ("STROKA_2" . 60)
      ("STROKA_3" . 90)
      ("STROKA_4" . nil)
     )
) ;_ kpblc-attr-hor

Re: Поворот атрибутов блока

> kpblc
Функция (vla-put-rotation x ang) принимает угол в радианах, а не в градусах.

> AY
Бывает... Переусердствовал в преобразованиях... smile

Re: Поворот атрибутов блока

> Александр Ривилис
О как! Понятно, буду знать.
AY, Олег (jr.), Александр Ривилис - огромное спасибо! Не могу выразить, как вы мне помогли. Буду учиться дальше :)

Re: Поворот атрибутов блока

поворот атрибутов
http://dwg.ru/dwl/342
может поможет кому?

Re: Поворот атрибутов блока

> cadhelp
V podobnih cluchayah polezna funktcia
qF_RotPtAxisOr smotri nije.

(setq *q_Err* 0.00000000001)
;;;                       Compare by *q_Err*                           ;;;
;;; if q_n1 and q_n2 pretty close - under *q_Err* -  return under  T   ;;;
(defun qF_InErr (q_n1 q_n2 )
    (if (and (not q_n1)(not q_n2))
        t
        (if (or (and (not q_n1)  q_n2) (and (not q_n2)  q_n1))
            nil
            (<= (Abs (- q_n1 q_n2))  *q_Err*))))
(defun qF_PtAddPt (q_pt1 q_pt2)
    (if (and (caddr q_pt1) (not (caddr q_pt2))) (setq q_pt2 (list (car q_pt2) (cadr q_pt2) 0.0)))
    (if (and (caddr q_pt2) (not (caddr q_pt1))) (setq q_pt1 (list (car q_pt1) (cadr q_pt1) 0.0)))
    (if (caddr q_pt1)
        (list (+ (car q_pt1) (car q_pt2)) (+ (cadr q_pt1) (cadr q_pt2)) (+ (caddr q_pt1) (caddr q_pt2)))
        (list (+ (car q_pt1) (car q_pt2)) (+ (cadr q_pt1) (cadr q_pt2)))))
(defun qF_PtMinusPt (q_pt1 q_pt2)
    (if (and (caddr q_pt1) (not (caddr q_pt2))) (setq q_pt2 (list (car q_pt2) (cadr q_pt2) 0.0)))
    (if (and (caddr q_pt2) (not (caddr q_pt1))) (setq q_pt1 (list (car q_pt1) (cadr q_pt1) 0.0)))
    (if (caddr q_pt1)
        (list (- (car q_pt1) (car q_pt2)) (- (cadr q_pt1) (cadr q_pt2)) (- (caddr q_pt1) (caddr q_pt2)))
        (list (- (car q_pt1) (car q_pt2)) (- (cadr q_pt1) (cadr q_pt2)))))
;;;  Rotate q_pt on q_Angle around q_Axis -X or Y or Z ;;;
;;; (qF_RotPtAxis q_pt q_Angle q_Axis)                 ;;;
;;; q_pt - point                                       ;;;
;;; If q_Angle is string - gradus                      ;;;
;;; If q_Angle is number - radians                     ;;;
;;; q_Axis - axis could be "X" "Y" "Z"                 ;;;
(defun qF_RotPtAxis (q_pt q_Angle q_Axis / q_x q_y q_z)
    (if (and (eq (type q_Angle) 'STR) (not (member q_Angle (list "0" "360" "90" "-270" "180" "-180" "270" "-90"))))
        (setq q_Angle (/ (* (distof q_Angle 2) pi) 180.0)))                    
    (setq q_x (car q_pt) q_y (cadr q_pt))
    (if (caddr q_pt) (setq q_z (caddr q_pt)) (setq q_z 0.0))
    (if (or (eq q_Angle "0")(eq q_Angle "360") (qF_InErr (if (eq (type q_Angle) 'STR) (distof q_Angle 2) q_Angle) 0))
        q_pt
    (progn
    (cond
        ((or (eq q_Angle "90") (eq q_Angle "-270") (qF_InErr (if (eq (type q_Angle) 'STR) (distof q_Angle 2) q_Angle)(/ pi 2)))
         (setq q_Sin 1.0 q_Cos 0.0 ))
        ((or (eq q_Angle "180") (eq q_Angle "-180") (qF_InErr (if (eq (type q_Angle) 'STR) (distof q_Angle 2) q_Angle) pi ))
         (setq q_Sin 0.0 q_Cos -1.0 ))
        ((or (eq q_Angle "270") (eq q_Angle "-90") (qF_InErr (if (eq (type q_Angle) 'STR) (distof q_Angle 2) q_Angle) (* (/ pi 2) 3)))
         (setq q_Sin -1.0 q_Cos 0.0 ))
        ((numberp q_Angle)
         (setq q_Sin (sin q_Angle) q_Cos (cos q_Angle)))
        (t nil))
    (cond
        ((eq q_Axis "Z")(list (+ (* q_x q_Cos) (* q_y q_Sin)) (- (* q_y q_Cos) (* q_x q_Sin)) q_z))
        ((eq q_Axis "X")(list q_x (+ (* q_y q_Cos) (* q_z q_Sin)) (- (* q_z q_Cos) (* q_y q_Sin))))
        ((eq q_Axis "Y") (list  (+ (* q_x q_Cos) (* q_z q_Sin)) q_y (- (* q_z q_Cos) (* q_x q_Sin))))
        (t nil))))
    )
; Rotate q_Pt around q_PtOr on q_Angle by q_Axis ;
; see qF_RotPtAxis                               ;
(defun qF_RotPtAxisOr (q_Pt q_PtOr q_Angle q_Axis)
    (qF_PtAddPt (qF_RotPtAxis (qF_PtMinusPt q_Pt q_PtOr) q_Angle q_Axis) q_PtOr))

Predvidya voprosi:
1 qF_InErr real'no slojnee zdes' mojno zamenit' na equal s pogreshnost'yu.
2 qF_RotPtAxis mojet oboytis' posldenim "COND"
no suschestvuyuschey podhod znachitel'no shijaet vremya vichesleniy

Re: Поворот атрибутов блока

function qF_InErr does the same as lisp function (equal arg1 arg2 precision)
(setq *q_Err* 0.00000000001)
(qF_InErr 1 1.000000001)
or
(equal 1 1.000000001 0.00000000001)
for the rest i have no time to check yet

Re: Поворот атрибутов блока

> cadhelp
Absolutno verno
Vnizu > PalStudio (2005-08-17 21:23:47) tak i napisano:
Predvidya voprosi:
1 qF_InErr real'no slojnee zdes' mojno zamenit' na equal s pogreshnost'yu.
2 qF_RotPtAxis mojet oboytis' posldenim "COND"
no suschestvuyuschey podhod znachitel'no shijaet vremya vichesleniy
vdobavlenii
(defun qF_RotPtAxisOrLs (q_PtLs q_PtOr q_Angle q_Axis / q_v)
    (mapcar '(lambda (q_v) (qF_RotPtAxisOr q_v q_PtOr q_Angle q_Axis)) q_PtLs))
(qF_RotPtAxisOrLs q_BigList (list 20.0 20.0 0.0) (- (qF_Dxf 50 q_EntGet)) "Z")
ili
(qF_RotPtAxisOrLs q_BigList (list 20.0 20.0 0.0) "270" "Z")

Re: Поворот атрибутов блока

> AY
[rus]podskazhi POZHALUJJSTA a kak
prochitat' znachenie attributa
iz etoJJ sxemy
spasibo
[/rus]
(defun kpblc-attr-hor (block)
    (foreach x
               (vlax-safearray->list
                   (vlax-variant-value
                       (vla-GetAttributes
                           (vlax-ename->vla-object block)
                       )
                   )
               )
;        (vla-put-rotation x 0)
???????????????
    )
)

Re: Поворот атрибутов блока

У меня ничего не получается, или как вызывать программу AY от 2005-08-16 14:53:45??? и как ей пользоваться, обьясните вкратце, вроде бы вещь полезная))