Rotate multiple blocks about the insertion point to global fixed point.

[feargt]

Hi,

Could anyone assist me in modifying the following code that I found to enable the following:

step 1:Select blocks
step 2: Select a single point that all blocks should point towards (blocks are arrows and all have to point towards mecca)

step 3: then using the rotate command on each block

base point = insertion point
use a reference angle of 90
for the new angle it should use a point (that being the point selected in step 2)


#
;RotBlock.lsp by Maurizio
;Start code
(defun C:RotBlock ()
(princ “nSelect blocks: “)
(setq grp (ssget))
(setq rotAngle (getangle “nRotation angle: “)) ;
(setq rotAngle (atof (angtos rotAngle 0)))
(setq j 0)
(repeat (sslength grp)
(setq eName (ssname grp j))
(setq pt (cdr (assoc 10 (entget eName))))
(command “_rotate” eName “” pt rotAngle)
(setq j (1+ j))
)
)
;End code
#

for me I need to change this to
(setq rotAngle (getangle “nRotation angle: “)) ;
(setq rotAngle (atof (angtos rotAngle 0)))

to (setq Rotangle (getpoint "nRotate block to point: "))

and this line
(command “_rotate” eName “” pt rotAngle)

to (command "_rotate" ename "" pt "_r" "90" "_p" rotangle)

but that does not do it.

any ideas? I thought it strange that I was not able to find a similar lisp online.

Any help much appreciated.
thanks

[GHarvey]

This is necessarily basic, as I am unfortunately pressed for time, but it should do what you seem to be requesting...

(defun c:pointat ( / ARRW-N ARRWS N N-PT NUM PTA)
  (vl-load-com)
  (if (setq arrws (ssget '((0 . "INSERT")))
	    ); setq
    (progn
      (setq num (sslength arrws)
	    pta (getpoint "\nPick the Target... ")
	    n 0
	    ); setq
      (while (< n num)
	(setq arrw-n (vlax-ename->vla-object (ssname arrws n))
	      n-pt (vlax-get arrw-n 'insertionpoint)
	      n (1+ n)
	      ); setq
	(vla-put-rotation arrw-n (angle n-pt pta))
	); while
      ); progn
    (prompt "\nNo blocks selected. ")
    ); if
  (princ)
  ); defun

[Tharwat]

This may not give you the right direction if your blocks are not on zero angle , anyway try it and i can modify it if you in need of any .

(defun c:Test (/ ss i sn gr)
  ;; Tharwat 02. Oct. 2012 ;;;
  (if (setq ss (ssget "_:L" '((0 . "INSERT"))))
    (repeat (setq i (sslength ss))
      (setq sn (cons (ssname ss (setq i (1- i))) sn))
    )
  )
  (while (eq (car (setq gr (grread t 15 0))) 5)
    (redraw)
    (foreach b sn
      (entmod
        (subst
          (cons
            50
            (- (angle (cdr (assoc 10 (entget b))) (cadr gr)) (/ pi 2.))
          )
          (assoc 50 (entget b))
          (entget b)
        )
      )
    )
  )
  (princ)
)

[pbejse]

(defun c:Test (/ ss i sn gr rp)
  ;; Tharwat 02. Oct. 2012 ;;;
  (if (setq ss (ssget "_:L" '((0 . "INSERT"))))
    (repeat (setq i (sslength ss))
      (setq sn (cons (ssname ss (setq i (1- i))) sn))
    )
  )
  (while (eq (car (setq gr (grread t 15 0))) 5)
    (redraw)
    (foreach b sn
      (entmod
        (subst
          (cons
            50
            (- (angle (setq rp  (cdr (assoc 10 (entget b)))) (cadr gr)) (/ pi 2.))
          )
          (assoc 50 (entget b))
          (entget b)
        )
      )
      (grdraw rp (cadr gr) 1 1)
    )
  )(redraw)
  (princ)
)

[Tharwat]

I completely forgot about grdraw function .

Thanks pBejse .

[feargt]

Hi GHarvey,

Thanks for your help. This works in principle although there appears to be a little problem in that each block rotates what appears to be an extra 90 degrees.....any ideas?

[feargt]

Hi Tharwat,

Thanks for your help. I have problem with selecting the target point. I cannot snap to anything or insert coordinates at the command line. It works if I just select a random point on the screen. Any ideas on what I might be doing wrong.

Thanks for the help guys

[Tharwat]

You did not do anything wrong , but I used the grread function for graphic action ,
but anyway here is another one according to have mentioned in your last post .

(defun c:Test (/ ss p i sn)
  ;; Tharwat 03. Oct. 2012 ;;;
  (if (and (setq ss (ssget "_:L" '((0 . "INSERT")))) (setq p (getpoint "\n Specify target point :")))
    (repeat (setq i (sslength ss))
      (setq sn (ssname ss (setq i (1- i))))
      (entmod (subst (cons 50 (- (angle (cdr (assoc 10 (entget sn))) p) (/ pi 2.)))
                     (assoc 50 (entget sn))
                     (entget sn)
                     )
              )
      )
    )
  (princ)
  )

[feargt]

hi,

that's does exactly what I need, thanks for your help. Much appreciated.

This thread is now "Solved"!

thanks Tharwat

[Tharwat]

hi,

that's does exactly what I need, thanks for your help. Much appreciated.

This thread is now "Solved"!

thanks Tharwat

You're welcome anytime .