AfraLisp Blog

The AutoLisp/Visual Lisp/VBA Resource Website

AfraLisp Blog

Home Newsletter Utter Rubbish Coding Tips AutoCAD Tips Contact Downloads WAUN

Rotate All Blocks
Version 1.0

Written by: Steven Papke
Written on: 2/16/02

This routine asks the user to select a block. With the block name extracted, the user then inputs the rotation angle and the routine will rotate all blocks of the same name.

;CODING STARTS HERE
(defun *error* (msg)
(setvar "osmode" osm)
(setvar "cmdecho" cme)
(princ "error: ")
(princ msg)
(princ)
)

(defun c:rab ()
(setq osm (getvar "osmode"))
(setq cme (getvar "cmdecho"))
(setvar "cmdecho" 1)
(setvar "osmode" 255)
(command "undo" "mark")
(prompt "\nSelect source block: ")
(setq bkpic (entsel))
(setq bkpicmod (car bkpic))
(setq bknam (cdr (assoc 2 (entget bkpicmod))))
(initget 1)
(setq rotang (getreal "\nRotation Angle: "))
(setq count 0)
(prompt "\nSelect block(s) to rotate: ")
(setq ss (ssget))
(if ss
(progn
(setq count 0)
(setq chgblk 0)
(setq ssl (sslength ss))
(princ "\nIsolating Block ")
(princ bknam)
(princ " from selection set.")
(princ "\n")
(setvar "cmdecho" 0)
(while (< count ssl)
(setq blk (entget (ssname ss count)))
(setq sinspt (cdr (assoc 10 blk)))
(setq sblk (cdr (assoc 2 blk)))
(if (= bknam sblk)
(progn
(if (/= (substr (cdr (assoc 2 blk)) 1 8) "*")
(command "ROTATE" (ssname ss count) "" sinspt rotang)
)
(setq chgblk (+ 1 chgblk))
)
)
(setq count (+ 1 count))
)
)
)
(princ ssl)
(princ " objects found.")
(princ "\n")
(princ chgblk)
(princ " blocks rotated.")
(setvar "osmode" osm)
(setvar "cmdecho" cme)
(princ)
)
(princ)
;CODING ENDS HERE

The AutoLisp/Visual Lisp/VBA Resource Website

Copyright © 1999-Perpetuity by AfraLisp

All rights reserved.
Information in this document is subject to change without notice.
Site created and maintained by Kenny Ramage

The AutoLisp/Visual Lisp/VBA Resource Website