home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p024 / 5.img / R11SUPP.EXE / AXROT.LSP < prev    next >
Encoding:
Lisp/Scheme  |  1990-07-30  |  3.5 KB  |  99 lines
  1. ;;; --------------------------------------------------------------------------;
  2. ;;; AXROT.LSP
  3. ;;;   Copyright (C) 1990 by Autodesk, Inc.
  4. ;;;  
  5. ;;;   Permission to use, copy, modify, and distribute this software and its
  6. ;;;   documentation for any purpose and without fee is hereby granted.  
  7. ;;;
  8. ;;;   THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED WARRANTY. 
  9. ;;;   ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR PURPOSE AND OF 
  10. ;;;   MERCHANTABILITY ARE HEREBY DISCLAIMED.
  11. ;;;
  12. ;;;   By Jan S. Yoder                                          May 11, 1988
  13. ;;;   Modified for AutoCAD Rel 11                              July    1990
  14. ;;; --------------------------------------------------------------------------;
  15. ;;; DESCRIPTION
  16. ;;;
  17. ;;;   A routine to do 3 axis rotation of a selection set.
  18. ;;;
  19. ;;; ---------------------------- Main program --------------------------------;
  20.  
  21. (defun c:axrot (/ axerr s olderr obpt oce ogm ohl oucsf ssel kwd dr bpt) 
  22.   (if (and (= (getvar "cvport") 1) (= (getvar "tilemode") 0)) 
  23.     (progn
  24.       (prompt "\n *** Command not allowed in Paper space ***\n") 
  25.       (princ)
  26.     ) 
  27.     (progn
  28.       ;; Internal error handler
  29.       
  30.       (defun axerr (s)                ; If an error (such as CTRL-C) occurs
  31.         ;; while this command is active...
  32.         (if (/= s "Function cancelled") 
  33.           (princ (strcat "\nError: " s))
  34.         ) 
  35.         (setq *error* olderr)         ; restore old *error* handler
  36.         (setvar "gridmode" ogm)       ; restore saved modes
  37.         (setvar "highlight" ohl)
  38.         (setvar "ucsfollow" oucsf)
  39.         (command "ucs" "restore" "_AXROT_")
  40.         (command "ucs" "del" "_AXROT_")
  41.         (command "undo" "e")         ; complete undo group
  42.         (setvar "cmdecho" oce)
  43.         (princ)
  44.       ) 
  45.       
  46.       (setq olderr *error* 
  47.             *error* axerr)
  48.       (setq oce (getvar "cmdecho") 
  49.             ogm (getvar "gridmode") 
  50.             ohl (getvar "highlight") 
  51.             oucsf (getvar "ucsfollow")
  52.       )
  53.       (setvar "cmdecho" 0)
  54.       (command "undo" "group") 
  55.       (command "ucs" "save" "_AXROT_")
  56.       (setvar "gridmode" 0)
  57.       (setvar "ucsfollow" 0)
  58.       (setq ssel (ssget))
  59.       
  60.       (if ssel
  61.         (progn
  62.           (setvar "highlight" 0)
  63.           (initget 1 "X Y Z") 
  64.           (setq kwd (getkword "\nAxis of rotation X/Y/Z: "))
  65.           (setq dr (getreal "\nDegrees of rotation <0>: "))
  66.           (if (null dr) 
  67.             (setq dr 0)
  68.           ) 
  69.           (setq bpt (getpoint "\nBase point <0,0,0>: "))
  70.           (if (null bpt) 
  71.             (setq bpt (list 0 0 0))
  72.           ) 
  73.           (setq bpt (trans bpt 1 0))
  74.           (cond ((= kwd "X") (command "ucs" "Y" "90")) 
  75.             ((= kwd "Y") (command "ucs" "X" "-90")) 
  76.             ((= kwd "Z") (command "ucs" "Z" "0"))
  77.           ) 
  78.           (setq bpt (trans bpt 0 1))
  79.           (command "rotate" ssel "" bpt dr) 
  80.           (command "ucs" "p")            ;restore previous ucs
  81.           (command "'redrawall") 
  82.         )
  83.         (princ "\nNothing selected. ")
  84.       )
  85.       (setvar "gridmode" ogm)         ;restore saved modes
  86.       (setvar "highlight" ohl)
  87.       (setvar "ucsfollow" oucsf)
  88.       (command "ucs" "del" "_AXROT_")
  89.       (command "undo" "e")            ;complete undo group
  90.       (setvar "cmdecho" oce)
  91.       (princ)
  92.     )
  93.   )
  94. ) 
  95. (princ "\n\tC:AXROT loaded.  Start command with AXROT.")
  96. (princ)
  97. ;;; --------------------------------------------------------------------------;
  98.  
  99.