Set Attribute Rotation using LISP

[mhibbitt]

I am looking for a lisp that will set the rotation of a selected entity (e.g. block w/ attributes, lines, etc...) 0 (zero).

Thanks for any help.

[Opie]

Things to consider:

• How are you selecting the entity?
• Are you wanting to select more than one?
• Will you be doing this with dxf or VisualLISP?
• What property of that entity will make it rotate?

[Tom Beauford]

I replaced rotate on my menu with this one. If you start it then select a single object it should work like you asked. Otherwize it works the same as the rotate command. It will even rotate hatch direction.

[mhibbitt]

Thanks Tom!

That worked, but only for one attribute inside the block at a time. Curious if there is a way to edit that lisp to rotate all attributes with in the block at the same time.

[Tom Beauford]

This one will rotate a group of blocks and their attributes using the insert pt of each block as the base for rotation.

[mhibbitt]

Tom, You are the man!!! That routine works perfectly!

Thanks for your help!

[koppesetic678873]

...where is the lisp file ???

[Tom Beauford]

...where is the lisp file ???

Not sure why it disappeared, but here it is again:

 ;;; Change Entinty Direction
;;; acad.lsp: (autoload "ENT_DIR" '("ED"))
;;; BY: TOM BEAUFORD
;;; BeaufordT@LeonCountyFL.gov
;;; LEON COUNTY PUBLIC WORKS ENGINEERING SECTION
;==================================================================
(defun C:ED (/ ss en pt e1 ed ha nol nha edb ed1 count la ofa os osa ang)
  (setq oldab (getvar "angbase"))
  (setvar "angbase" 0)
  (setq ss (ssget "I"))
  (if (= ss nil)(setq en (entsel "\nPick Entity or Press Enter to Select objects: ")))
  (if en
    (setq pt (cadr en)    ;pick coordinates
          e1 (car en)     ;entinty name
          ed (entget e1)  ;entinty list
    )
  );if
  (cond
   ((= "HATCH" (cdadr ed))
   (progn
    (setq  ha (cdr(assoc 52 ed))                             ;existing hatch angle
          nol (cdr(assoc 78 ed))                             ;# of pat lines
          nha (getangle "Pick Hatch Direction")              ;new hatch angle
           ed (subst(cons 52 nha)(assoc 52 ed)ed)            ;subst new hatch angle
          edb (list(car ed))                                 ;entinty list beg
          ed1 (cdr ed)                                       ;working entinty list
        count 0
    )
;edb = entinty list up to pattern lines
    (while(/= 53 (caar ed1))
      (setq edb (append edb (list(car ed1)))
            ed1 (cdr ed1)
      )
    )
    (repeat nol
      (setq la (assoc 53 ed1)                                ;existing pat line angle
            la (list(cons 53 (+ (- nha ha)(cdr la))))        ;new pat line angle
           ed1 (member (assoc 53 ed1) ed1)                   ;working entinty list
            pt (list (cdr(assoc 43 ed1))(cdr(assoc 44 ed1))) ;existing pat line base point
           ofa (+ (- nha ha)(angle '(0 0) pt))               ;new offset angle
            pt (polar '(0 0) nha (distance '(0 0) pt))       ;new pat line base point
      )
      (if (or(car pt)(cadr pt))
        (setq pt (polar '(0 0) ofa (distance '(0 0) pt))) ;new pat line base point
      )
      (setq edb (append edb la)                               ;add new pat line angle
            edb (append edb (list(cons 43 (car pt))))         ;add pat line x
            edb (append edb (list(cons 44 (cadr pt))))        ;add pat line y
             os (list (cdr(assoc 45 ed1))(cdr(assoc 46 ed1))) ;existing pat line offset
            osa (angle '(0 0) os)                             ;existing offset angle
            osa (+ (- nha ha) osa)                            ;new offset angle
             os (polar '(0 0) osa (distance '(0 0) os))       ;new pat line offset
            edb (append edb (list(cons 45 (car os))))         ;add offset x
            edb (append edb (list(cons 46 (cadr os))))        ;add offset y
            ed2 (member (assoc 79 ed1)ed1)
            ed1 (cdr ed1)
          count (+ 1 count)
      )
      (if(/= count nol)
        (while(/= 53 (caar ed2))
          (setq ed3 (list(car ed2))
                ed2 (cdr ed2)
                edb (append edb ed3)
          );setq
        );while
      );if            
    );repeat
    (setq ed2 (cdr(member(assoc 46 ed1)ed1)))
    (setq edb (append edb ed2))
   (setq ed edb)
   (entmod ed)
   (entupd e1)
   ));progn

   ((= "DIMENSION" (cdadr ed))
   (progn
    (setq pt (list (cadr(assoc 11 ed)) (caddr(assoc 11 ed)))
          ed (subst(cons 53 (getangle pt "Pick Text Angle"))(assoc 53 ed)ed))
   (entmod ed)
   ));progn

   ((or(= "TEXT" (cdadr ed))(= "MTEXT" (cdadr ed)))
   (progn
     (setq ang (angtos (cdr (assoc 50 ed))0 3))
     (prompt (strcat "\nCurrent Angle is <" ang "> "))
     (if(or(= "MTEXT" (cdadr ed))(=(+(cdr(assoc 72 ed))(cdr(assoc 73 ed)))0))
       (setq pt (list (cadr(assoc 10 ed)) (caddr(assoc 10 ed))))
       (setq pt (list (cadr(assoc 11 ed)) (caddr(assoc 11 ed))))
     )
     (setq ed (subst(cons 50 (getangle pt "\nPick or Enter new angle or Enter to pick two points for direction..."))
                    (assoc 50 ed)ed))
     (if(=(cdr(assoc 50 ed))nil)
       (setq pt (getpoint "\nPick two points for direction...")
             ed (subst(cons 50 (getangle pt "\nPick new direction..."))
                    (assoc 50 ed)ed))
     )
   (entmod ed)
   ));progn

   ((= "INSERT" (cdadr ed))
   (progn
    (setq en1 (nentselp "go get it" pt)) 
    (setq e1 (car en1))  ;entinty name
    (setq ed (entget e1)) ;entinty list
    (if(/= "ATTRIB" (cdadr ed))
      (progn
        (setq ed (entget (car en))
             ang (angtos (cdr (assoc 50 ed))0 3)
              pt (list (cadr(assoc 10 ed)) (caddr(assoc 10 ed)))
        ); setq
        (prompt (strcat "\nCurrent Angle is <" ang "> "))
        (setq ed(subst(cons 50 (getangle pt "Pick or Enter Block new Angle..."))
                      (assoc 50 ed)ed))
      );progn
      (progn
        (setq ang (angtos (cdr (assoc 50 ed))0 3)
               pt (list (cadr(assoc 10 ed)) (caddr(assoc 10 ed)))
        ); setq
        (prompt (strcat "\nCurrent Angle is <" ang "> "))
        (setq ed(subst(cons 50 (getangle pt "Pick or Enter new Attribute Angle..."))
                      (assoc 50 ed)ed))
      );progn
    );if
   (entmod ed)
   (entupd e1)
   ));progn

   (en(command "_rotate" en))

   (t(command "_rotate"))

  );cond
  (setvar "angbase" oldab)
  (setq ss nil)
  (princ)
)

another that might be useful:

 ;;; ROT_BLK.LSP
;;; Rotation of Selected Blocks
;;; BY: TOM BEAUFORD
;;; BeaufordT@LeonCountyFL.gov
;;; LEON COUNTY PUBLIC WORKS ENGINEERING SECTION
;===============================
(defun C:RB ( / ss rotang count e en basept refang)
 (command "._UNDO" "_BEgin")
 (setq ss (ssget '((0 . "INSERT"))))
 (initget (+ 1)) (setq rotang
 (getorient "\n->New rotation angle: "))
 (if(/= rotang 0)(setq rotang (/ (* rotang 180.0)pi)))
 (terpri)
 (setq count 0)
 (while (< count (sslength ss))
  (setq e (entget(ssname ss count)))
  (setq en (cdar e))
  (setq basept (cdr(assoc 10 e)))
  (setq refang (cdr(assoc 50 e)))
  (if(/= refang 0)(setq refang (/ (* refang 180.0)pi)))
  (command "_.rotate" en "" basept "R" refang rotang)
  (setq count (+ count 1))
  (princ)
 )
 (setq ss nil)
 (command "._UNDO" "_End")
)