Copy rotation angle of one block to another

[sm177y]

I have this function that copies the rotation angle of one block to another but it does not rotate the text attributes with the block like happens if I were to manually copy and paste the rotation angle from the one blocks properties menu to the other blocks. The attributes stay stuck at their previous rotation and position. How do I make this also affect the attributes so that it effectively does exactly the same thing as copying the rotation angle in the properties menu?

For a better description, I have a block that is a square with a text number in the middle of it. When I use this function it only rotates the square which brings the square away from the text and the text no longer resides within the square. If I copy the rotation in the properties menu of each block the text rotates with the square and stays inside of it.

 

;; copies rotation of one block to another
(defun c:cr (/ blk1 blk2 rot1)
  (setq blk1 (car (entsel "\nSelect block to copy rotation from: ")))
  (if (not (setq rot1 (cdr (assoc 50 (entget blk1)))))
    (progn
      (princ "\nBlock has no rotation angle.")
      (exit)
    )
  )
  (setq blk2 (car (entsel "\nSelect block to apply rotation to: ")))
  (entmod (subst (cons 50 rot1) (assoc 50 (entget blk2)) (entget blk2)))
  (princ)
)

 

[Tharwat]

Try this untested program.

(defun c:Test (/ pck int ent sel rot get)
  ;;----------------------------------------------------;;
  ;;	Author : Tharwat Al Choufi			;;
  ;; website: https://autolispprograms.wordpress.com	;;
  ;;----------------------------------------------------;;
  (and (princ "\nSelect single block to get rotation from : ")
       (or (setq pck (ssget "_+.:S:E" '((0 . "INSERT"))))
           (alert "Null or invalid object.! Try again")
           )
       (princ "\nSelect blocks to apply rotation on : ")
       (setq rot (assoc 50 (entget (ssname pck 0)))
             int -1
             sel (ssget "_:L" '((0 . "INSERT")))
             )
       (while (setq int (1+ int)
                    ent (ssname sel int)
                    )
         (and
           (setq get (entget ent))
           (entmod (subst rot (assoc 50 get) get))
           (= (cdr (assoc 66 get)) 1)
           (mapcar '(lambda (u) (vla-put-rotation u (cdr rot)))
                   (vlax-invoke (vlax-ename->vla-object ent) 'getattributes)
                   )
           )
         )
       )
  (princ)
  ) (vl-load-com)

 

[Nikon]

This program works great! Bravo Tharwat!

[Tharwat]

2 hours ago, Nikon said:

This program works great! Bravo Tharwat!

Thank you for your kind feedback.  

[sm177y]

So it does rotate the text but it does not maintain its position within the block. The center text in the square has been copied to the rotate of the first block, 0 in my test, but the text is half outside the square instead of in the center. If I do this manually in the properties menu it is not an issue.

 

I was able to get my hands on this which essentially does what i want but requires defining an angle. is it possible to extract the angle from the first block and apply it to the other block via this method somehow?

 

(defun dtr (a)
 (* pi (/ a 180.0)))
(defun rtd (a)
 (/ (* a 180.0) pi))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;; Prompts you to select 2 point to set an angle ;;;;;
;;;;;;   then select block(s) you want to rotate   ;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun c:as ()
  (setq cecho (getvar "cmdecho"))
  (setvar "cmdecho" 0)
;  (setq blknam (getstring "\nEnter block name to set angles to: "))
;(setq blksel (ENTSEL "\nPick Block to rotate..."))
;(setq blkent (car blksel))
;(SETQ blknam (cdr (assoc 2 (entget blkent))))
  (prompt "\nPick two points to set angle: ")
  (setvar "osmode" 545)
  (setq setang (getangle))
  (setq setang (rtd setang))
  (setvar "osmode" 0)
  (setq selset (ssget (list (cons 2 "*"))))
  (if (= selset nil)
    (progn
      (prompt "\nNo block found...GOODBYE!\n")
      (exit)
      (princ)
    ) ;_end of progn
  ) ;_end if
  (setq setlen (sslength selset))
  (repeat setlen
    (setq blkent (ssname selset (setq setlen (- setlen 1)))
      blkpnt (cdr (assoc 10 (entget blkent)))
      blkang (cdr (assoc 50 (entget blkent)))
    )
    (setq newang (+ (- 360 (rtd blkang)) setang))
    (command "rotate" blkent "" blkpnt newang)
  );_end repeat

)

[BIGAL]

My suggestion.
 

  (setvar "osmode" 545)
  (setq setang (getangle (getpoint "\nPick 1st point for angle ")(getpoint "\nPick 2nd point ")))
or better
(setq pt1 (getpoint "\nPick 1st point for angle ") pt2 (getpoint pt1 "\nPick 2nd point "))
(setq setang (getangle pt1 pt2))

 

Edited May 23, 2023 by BIGAL

[ronjonp]

11 hours ago, BIGAL said:

My suggestion.
 

  (setvar "osmode" 545)
  (setq setang (getangle (getpoint "\nPick 1st point for angle ")(getpoint "\nPick 2nd point ")))
or better
(setq pt1 (getpoint "\nPick 1st point for angle ") pt2 (getpoint pt1 "\nPick 2nd point "))
(setq setang (getangle pt1 pt2))

 

@BIGAL

How is this relevant ? The OP is matching rotation from an existing block.

[sm177y]

1 minute ago, ronjonp said:

@BIGAL

How is this relevant ? The OP is matching rotation from an existing block.

I thought he was thinking of a modification to the other function I posted that sort of does a similar thing but that doesn't really solve the issue with that example. It rotates blocks properly with the attributes in their relative places but it requires you to manually define the angle instead of being able to copy it from an existing block. I provided it as a possible means of fixing whatever wasn't working with Tharwat's idea as the rotation of the attributes works properly in that but requires a defined angle and Tharwat's doesn't require a defined angle but also doesn't rotate the attributes properly.

[Tharwat]

I guess you need to modify your attributed block via modifying the attribute object that located inside that box to Middle Center to guarantee the perfect rotation all together.

It would be great if you can upload a sample drawing with your attributed block to take a close look.

[sm177y]

It's already middle center. Here's a sample dwg. The first block is the one at zero rotation i'm trying to copy. The 2nd is before the rotation copy and the 3rd is the same as the 2nd but after applying the function to it. Thanks for your time on this

test.dwg

[Nikon]

If you select all blocks (even with different names and different angles of turns), 
then you can
set the required angle for all blocks in the properties. 
And the attributes remain in their places after the turn...

[Tharwat]

Give this a shot and let me know, although what you want in this case just to run the ATTSYNC command on the selected attributed blocks.

(defun c:Test (/ pck int ent sel rot get lst bkn )
  ;;----------------------------------------------------;;
  ;;	Author : Tharwat Al Choufi			;;
  ;; website: https://autolispprograms.wordpress.com	;;
  ;;----------------------------------------------------;;
  (and (princ "\nSelect single block to get rotation from : ")
       (or (setq pck (ssget "_+.:S:E" '((0 . "INSERT"))))
           (alert "Null or invalid object.! Try again")
           )
       (princ "\nSelect blocks to apply rotation on : ")
       (setq rot (assoc 50 (entget (ssname pck 0)))
             int -1
             sel (ssget "_:L" '((0 . "INSERT")))
             )
       (while (setq int (1+ int)
                    ent (ssname sel int)
                    )
         (and
           (setq get (entget ent))
           (entmod (subst rot (assoc 50 get) get))
           (= (cdr (assoc 66 get)) 1)
           (or (member (setq bkn (cdr (assoc 2 get))) lst)
               (setq lst (cons bkn lst))
               )
           (mapcar '(lambda (u)
                      (vla-put-rotation u (cdr rot)))
                   (vlax-invoke (vlax-ename->vla-object ent) 'getattributes)
                   )
           )
         )
       )
  (and lst (mapcar '(lambda (u) (vl-cmdf "_.ATTSYNC" "_N" u)) lst))
  (princ)
  ) (vl-load-com)

 

[Nikon]

Tharwat
Is it possible to add ATTSYNC in lisp for the selected rotated blocks?

[Tharwat]

I already added it into my previous reply. 

[Nikon]

But it doesn't work, attributes move out...
In the figure, 
the first block is rotated through properties, the rest using lisp.
AutoCAD 2015.

[Tharwat]

I don't know about your block status, but on OP's block, so here is a demo using two rotations

 

[Nikon]

No, I'm sorry, now the block is rotated and the attributes are not shifted...

[Tharwat]

The alignment of attribute object should in Middle Center which would guarantee perfect rotation in blocks.

[sm177y]

5 hours ago, Tharwat said:

Give this a shot and let me know, although what you want in this case just to run the ATTSYNC command on the selected attributed blocks.

(defun c:Test (/ pck int ent sel rot get lst bkn )
  ;;----------------------------------------------------;;
  ;;	Author : Tharwat Al Choufi			;;
  ;; website: https://autolispprograms.wordpress.com	;;
  ;;----------------------------------------------------;;
  (and (princ "\nSelect single block to get rotation from : ")
       (or (setq pck (ssget "_+.:S:E" '((0 . "INSERT"))))
           (alert "Null or invalid object.! Try again")
           )
       (princ "\nSelect blocks to apply rotation on : ")
       (setq rot (assoc 50 (entget (ssname pck 0)))
             int -1
             sel (ssget "_:L" '((0 . "INSERT")))
             )
       (while (setq int (1+ int)
                    ent (ssname sel int)
                    )
         (and
           (setq get (entget ent))
           (entmod (subst rot (assoc 50 get) get))
           (= (cdr (assoc 66 get)) 1)
           (or (member (setq bkn (cdr (assoc 2 get))) lst)
               (setq lst (cons bkn lst))
               )
           (mapcar '(lambda (u)
                      (vla-put-rotation u (cdr rot)))
                   (vlax-invoke (vlax-ename->vla-object ent) 'getattributes)
                   )
           )
         )
       )
  (and lst (mapcar '(lambda (u) (vl-cmdf "_.ATTSYNC" "_N" u)) lst))
  (princ)
  ) (vl-load-com)

 

This definitely works the way it should. Better really as it allows applying the angle to multiple things at once. Thank you so much!
As I don't quite understand what was fixed. Would you mind explaining a little bit on what finally made the text align properly?

I'm still somewhat new to AutoLISP.