Results 1 to 4 of 4

Thread: Attribute Rotate then Reposition?

  1. #1
    Login to Give a bone
    0

    Default Attribute Rotate then Reposition?

    I am trying to find a lisp that will rotate a single attribute to 0 degrees then be able to reposition it?
    Thanks
    Brad

  2. #2
    Certifiable AUGI Addict
    Join Date
    2001-03
    Location
    Tallahassee, FL
    Posts
    3,297
    Login to Give a bone
    0

    Default Re: Attribute Rotate then Reposition?

    I use this routine as a replacement for the Rotate command:
    Code:
     ;;; 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)
    )
    You could move it afterwards using its grip.
    Tom Beauford P.S.M. - Civil 2020 on Windows 10 Enterprise
    Design Analysis - Leon County Public Works/Engineering Wrap [CODE] tags around selected text
    2280 Miccosukee Rd. Tallahassee, FL 32308-5310
    Ph# (850)606-1516 Home Page

  3. #3
    AUGI Addict alanjt's Avatar
    Join Date
    2008-02
    Posts
    1,141
    Login to Give a bone
    0

    Default Re: Attribute Rotate then Reposition?

    ..........
    Last edited by alanjt; 2012-04-23 at 01:41 PM.

  4. #4
    AUGI Addict alanjt's Avatar
    Join Date
    2008-02
    Posts
    1,141
    Login to Give a bone
    0

    Default Re: Attribute Rotate then Reposition?

    ..................................................
    Last edited by alanjt; 2012-03-11 at 04:09 PM.

Similar Threads

  1. Replies: 6
    Last Post: 2014-09-24, 08:11 AM
  2. 2012: Rotate Attribute in a Dynamic Block
    By KansasCAD in forum Dynamic Blocks - Technical
    Replies: 5
    Last Post: 2013-03-13, 06:38 PM
  3. Rotate block not attribute within
    By fletch97 in forum Dynamic Blocks - Technical
    Replies: 6
    Last Post: 2009-02-06, 08:56 PM
  4. Can't get attribute to rotate in dynamic block
    By tim.101799 in forum Dynamic Blocks - Technical
    Replies: 2
    Last Post: 2006-07-20, 04:14 PM
  5. Add Attribute Rotate in ROTATE command
    By arshadmirza786 in forum AutoCAD Wish List
    Replies: 0
    Last Post: 2005-01-12, 09:40 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •