(vl-load-com)

(defun RotBlock_err (ms)
  (RotBlock_res) 
  (princ (strcat "\nRotBlock: " ms)) (princ)
)
(defun RotBlock_res ()
  (Undo nil)
  (setq *error* olderr olderr nil) (princ)
)

;Beendet in jedem Fall eine event. begonnene Undo-Gruppe.
;Ist [se=T] wird dann eine neue Undo-Gruppe gestartet.
(defun Undo (se / ad)
  (setq ad (vla-get-ActiveDocument (vlax-get-acad-object)))
  (while (eq (logand 8 (getvar "undoctl")) 8) (vla-EndUndoMark ad))
  (if se (vla-StartUndoMark ad))
  (princ)
)

;Geklickte Blöcke manuell drehen mit 3 Modi:
;Option O: Es wird nur der Block ohne Attribute gedreht
;Option S: Der Block wird samt seinen Attributen gedreht (Standard)
;Option A: Attribute werden zwar mitgedreht, ihre Ausrichtung bleibt aber gleich
;Bei Attributen werden gesperrte Layer berücksichtigt.
(defun C:RotBlock (/ tx lg kw gr ss en ed ip on al dl ll lo ri)
  (setq olderr *error* *error* RotBlock_err)
  (if (not *ar*) (setq *ar* "S"))
  (setq tx "\nOhne Attribute/Standard/Attribute ausrichten <O/S/A> "
        lg (vla-get-Layers (vla-get-ActiveDocument (vlax-get-Acad-Object)))
  )
  (initget " O S A")
  (if (setq kw (getkword (strcat tx "<" *ar* ">: ")))
      (setq *ar* kw)
  )
  (while
    (and
      (progn (princ "\nBlock wählen: ") (grread T))
      (setq gr (grread nil 4 2))
      (= (car gr) 3)
    )
    (if (and (setq ss (ssget (cadr gr)))
             (setq en (ssname ss 0))
             (setq ed (entget en))
             (= (cdr (assoc 0 ed)) "INSERT")
             (setq ip (cdr (assoc 10 ed)))
        )
        (progn
          (Undo T)
          (setq on (vlax-ename->vla-object en))
          (if (= (vlax-get on 'HasAttributes) -1)
              (progn
                (setq al (vlax-safearray->list
                           (vlax-variant-value (vla-getAttributes on))
                         )
                      dl nil
                      ll nil
                )
                (foreach at al
                  (setq lo (vla-item lg (vlax-get at 'Layer)))
                  (if (= (vlax-get lo 'Lock) -1)
                      (progn
                        (setq dl (cons (entget (vlax-vla-object->ename at)) dl)
                              al (vl-remove at al)
                              ll (cons lo ll)
                        )
                        (vlax-put lo 'Lock 0)
                      )
                      (setq al (subst (list at (vlax-get at 'Rotation)) at al))
                  )
                )
              )
              (setq al nil dl nil)
          )
          (princ "\nRichtung zeigen: ")
          (while (= (car (setq gr (grread T 4 0))) 5)
            (setq ri (angle ip (cadr gr)))
            (cond
              ((= *ar* "O")
               (setq ed (subst (cons 50 ri) (assoc 50 ed) ed))
               (entmod ed)
              )
              ((or (= *ar* "S") (= *ar* "A"))
               (vlax-put on 'Rotation ri)
               (foreach ed dl (entmod ed) (entupd (cdr (assoc -1 ed))))
               (if (and al (= *ar* "A"))
                   (foreach at al (vlax-put (car at) 'Rotation (cadr at)))
               )
              )
            )
          )
          (foreach lo ll (vlax-put lo 'Lock -1))
        )
    )
  )
  (RotBlock_res)
)