home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p024 / 5.img / R11SUPP.EXE / RECTANG.LSP < prev    next >
Encoding:
Lisp/Scheme  |  1990-09-07  |  2.4 KB  |  72 lines
  1. ;;;   RECTANG.lsp
  2. ;;;   Copyright (C) 1990 by Autodesk, Inc.
  3. ;;;  
  4. ;;;   Permission to use, copy, modify, and distribute this software and its
  5. ;;;   documentation for any purpose and without fee is hereby granted.  
  6. ;;;
  7. ;;;   THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED WARRANTY. 
  8. ;;;   ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR PURPOSE AND OF 
  9. ;;;   MERCHANTABILITY ARE HEREBY DISCLAIMED.
  10. ;;; 
  11. ;;;   by Amy Berger
  12. ;;;   April, 1990
  13. ;;;
  14. ;;;--------------------------------------------------------------------------
  15. ;;; DESCRIPTION
  16. ;;;
  17. ;;;   RECTANG.LSP
  18. ;;; 
  19. ;;;   This lisp routine creates a 2d square or rectangle in the currect ucs.      ;;;   
  20. ;;;
  21. ;;;
  22. ;;;--------------------------------------------------------------------------
  23.  
  24.  
  25. (defun myerror (s)                    ; If an error (such as CTRL-C) occurs
  26.                                       ; while this command is active...
  27.   (if (/= s "Function cancelled")
  28.     (princ (strcat "\nError: " s))
  29.   )
  30.   (setvar "cmdecho" ocmd)             ; Restore saved modes
  31.   (setvar "blipmode" oblp)
  32.   (setq *error* olderr)               ; Restore old *error* handler
  33.   (princ)
  34. )
  35.  
  36. (defun c:rectang (/ olderr ocmd oblp pt1 pt2 pt3 pt4 l w)
  37.   (setq olderr  *error*
  38.         *error* myerror)
  39.   (setq ocmd (getvar "cmdecho"))
  40.   (setq oblp (getvar "blipmode"))
  41.   (setvar "cmdecho" 0)
  42.   (initget 1)                         ;3D point can't be null
  43.   (setq pt1 (getpoint (strcat "\nCorner of rectangle or square: ")))
  44.   (setvar "ORTHOMODE" 1)
  45.   (initget 7)                         ;Length can't be 0, neg, or null
  46.   (setq l (getdist pt1 "\nLength: "))
  47.   (setq pt2 (list (+ (car pt1) l) (cadr pt1) (caddr pt1)))
  48.   (grdraw pt1 pt2 2)
  49.   (initget 7 "Square")                ;Width can't be 0, neg, or null
  50.   (setq w (getdist pt1 "\nSquare/<Width>: "))
  51.   (if (= w "Square") 
  52.       (setq w l)
  53.   )
  54.   (setq pt3 (list (car pt2) (+ (cadr pt2) w) (caddr pt2)))
  55.   (setq pt4 (list (car pt1) (+ (cadr pt1) w) (caddr pt1)))
  56.   (grdraw pt2 pt3 2)
  57.   (grdraw pt3 pt4 2)
  58.   (grdraw pt4 pt1 2)
  59.   (setvar "ORTHOMODE" 0)
  60.   (command "pline" pt1 pt2 pt3 pt4 "close")
  61.   (prompt "\nRotation angle: ")
  62.   (command "rotate" "l" "" pt1 pause)
  63.   (setvar "cmdecho" ocmd)
  64.   (setvar "blipmode" oblp)
  65.   (setq *error* olderr)               ; Restore old *error* handler
  66.   (princ)
  67. )
  68.  
  69. (defun c:rect() (c:rectang))
  70. (princ "\n\tC:RECTANG loaded.  Start command with RECT or RECTANG.")
  71. (princ)
  72.