Jump to content

Copy rotation angle of one block to another


sm177y

Recommended Posts

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)
)

 

Link to comment
Share on other sites

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)

 

  • Like 1
Link to comment
Share on other sites

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

)

Capture.PNG

Link to comment
Share on other sites

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 by BIGAL
  • Dislike 1
Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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...

Image 11.jpg

Image 12.jpg

Link to comment
Share on other sites

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)

 

Link to comment
Share on other sites

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

Image 3.png

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...