home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 September / Simtel20_Sept92.cdr / msdos / autocad / door.arc / DOOR.LSP
Text File  |  1989-12-09  |  6KB  |  136 lines
  1. ;;; -*-  Mode: LISP -*- (C) Ben Olasov 1988, 1989
  2. ;;;  Not-so-tiny two-pick door command
  3.  
  4. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  5. ;;; File: DOOR.LSP     Copyright (C) Ben Olasov 1989                        ;;;
  6. ;;; Inquiries:                                                              ;;;
  7. ;;;                                                                         ;;;
  8. ;;;     Ben Olasov                                                          ;;;
  9. ;;;     Graphic Systems, Inc.:                                              ;;;
  10. ;;;                                                                         ;;;
  11. ;;;                    New York, NY:   PH (212) 725-4617                    ;;;
  12. ;;;                    Cambridge, MA:  PH (617) 492-1148                    ;;;
  13. ;;;                    MCI-Mail:       GSI-NY   344-4003                    ;;;
  14. ;;;                                                                         ;;;
  15. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  16.  
  17. ;; This program is provided 'as is' without warranty of any kind, either 
  18. ;; expressed or implied, including, but not limited to the implied warranties of
  19. ;; merchantability and fitness for a particular purpose.  The entire risk as to
  20. ;; the quality and performance of the program is with the user.  Should the 
  21. ;; program prove defective, the user assumes the entire cost of all necessary 
  22. ;; servicing, repair or correction. 
  23. ;; AutoLisp and AutoCad are registered trademarks of AutoDesk, Inc.
  24.  
  25. (gc)
  26. (vmon)
  27. (princ "\nPlease wait- loading.. ")
  28.  
  29. (DEFUN C:DOOR (/ HP1 HP2 DWIDTH SP1 SP2 C-LAY BOX LIN1 LINE1 LINE2)
  30.        (MODES '("CMDECHO" "COORDS" "OSMODE" "BLIPMODE"))
  31.        (SETVAR "CMDECHO" 0)
  32.        (SETVAR "COORDS" 2)
  33.        (SETVAR "OSMODE" 256)
  34.        (SETQ HP1 (GETPOINT "\nHinge pt: ")
  35.              HP1 (OSNAP HP1 "NEAR")
  36.              SP1 (GETPOINT HP1 "\nSwing pt: ")
  37.              SP1 (OSNAP SP1 "NEAR")
  38.              DWIDTH (DISTANCE HP1 SP1)
  39.              C-LAY (GETVAR "CLAYER"))
  40.        (SETVAR "OSMODE" 0)
  41.        (SETQ BOX (SSGET "C" (LIST (- (CAR HP1) 12.0) (- (CADR HP1) 12.0))
  42.                             (LIST (+ (CAR HP1) 12.0) (+ (CADR HP1) 12.0))))
  43.        (IF (AND BOX
  44.                 (SETQ LIN1 (SSGET HP1))
  45.                 (SETQ L_NM (SSNAME LIN1 0))
  46.                 (LINE? L_NM))
  47.            (PROGN (SETQ LINE1 (ENTGET L_NM))
  48.                   (SSDEL (CDR (ASSOC -1 LINE1)) BOX) ;; remove first line from box
  49.                   (FOREACH ENT (SS2ENAMLIST BOX)
  50.                            (SETQ E (ENTGET ENT))
  51.                            (IF (OR (/= (CDR (ASSOC 8 E))
  52.                                        (CDR (ASSOC 8 LINE1)))
  53.                                    (/= (CDR (ASSOC 0 E)) "LINE")
  54.                                    (NOT (PARALLEL E LINE1)))
  55.                                (SSDEL (CDR (ASSOC -1 E)) BOX)))
  56.                   (SETVAR "OSMODE" 0)
  57.                   (SETVAR "BLIPMODE" 0)
  58.                   (IF (> (SSLENGTH BOX) 0) ;; look in the box
  59.                       (PROGN (SETQ LINE2 (ENTGET (SSNAME BOX 0))
  60.                                    HP2 (INTERS (CDR (ASSOC 10 LINE2))
  61.                                                (CDR (ASSOC 11 LINE2))
  62.                                    HP1 (POLAR HP1 (IF (> PI (ANGLE HP1 SP1))
  63.                                                       (- (ANGLE HP1 SP1) (/ PI 2.0))
  64.                                                       (+ (ANGLE HP1 SP1) (/ PI 2.0)))
  65.                                               (DISTANCE HP1 SP1)) nil))
  66.                              (COMMAND "LAYER" "S" (CDR (ASSOC 8 LINE1)) "")
  67.                              (SETQ SP2 (POLAR HP2 (ANGLE HP1 SP1) DWIDTH)
  68.                                    P5 (POLAR HP1 (ANGLE HP2 HP1) DWIDTH))
  69.                              (COMMAND "BREAK" HP1 SP1)
  70.                              (COMMAND "BREAK" HP2 SP2)
  71.                              (COMMAND "LINE" HP1 HP2 "")
  72.                              (COMMAND "LINE" SP1 SP2 "")
  73.                              (COMMAND "LINE" HP1 P5 "")
  74.                              (COMMAND "ARC" SP1 "E" P5 "D" (ATOF (ANGTOS (ANGLE HP2 HP1) 0 4)))
  75.                              (COMMAND "LAYER" "S" C-LAY ""))))
  76.            (PRINC "\ndoor: invalid selection set"))
  77.        (MODER)
  78.        (PRINC))
  79.  
  80. (princ "\rPlease wait- loading.. \\")
  81.  
  82. ;; convert a selection set to a list of entity names
  83. (DEFUN SS2ENAMLIST (SS / ENTLIST COUNTER)
  84.         (SETQ COUNTER 0)
  85.         (REPEAT (SSLENGTH SS)
  86.             (PROGN (SETQ ENTLIST (CONS (SSNAME SS COUNTER) ENTLIST))
  87.                    (SETQ COUNTER (1+ COUNTER)))) ENTLIST)
  88.  
  89. (princ "\rPlease wait- loading.. \|")
  90.  
  91. (DEFUN PARALLEL (LINE1 LINE2)                 ;; takes 2 e-lists as arguments-
  92.        (OR (~= (ANGLE (CDR (ASSOC 10 LINE1))  ;; allow tolerance for nearly 
  93.                       (CDR (ASSOC 11 LINE1))) ;; parallel lines
  94.                (ANGLE (CDR (ASSOC 10 LINE2))
  95.                       (CDR (ASSOC 11 LINE2))) (/ PI 180.0)) ;; 1 rad tolerance
  96.            (~= (ANGLE (CDR (ASSOC 11 LINE1))
  97.                       (CDR (ASSOC 10 LINE1)))
  98.                (ANGLE (CDR (ASSOC 10 LINE2))
  99.                       (CDR (ASSOC 11 LINE2))) (/ PI 180.0))))
  100.  
  101. (princ "\rPlease wait- loading.. \/")
  102.  
  103. (DEFUN ~= (ACT_VAL TEST_VAL TOL)  ;;fuzzy equality
  104.        (AND (<= ACT_VAL (+ TEST_VAL TOL))
  105.             (>= ACT_VAL (- TEST_VAL TOL))))
  106.  
  107. (princ "\rPlease wait- loading.. \-")
  108.  
  109. ;; from AutoDesk
  110. (DEFUN MODES (A)
  111.        (SETQ MLST '())
  112.        (REPEAT (LENGTH A)
  113.                (SETQ MLST (APPEND MLST (LIST (LIST (CAR A) (GETVAR (CAR A))))))
  114.                (SETQ A (CDR A))))
  115.  
  116. (princ "\rPlease wait- loading.. \\")
  117.  
  118. ;; from AutoDesk
  119. (DEFUN MODER ()
  120.        (REPEAT (LENGTH MLST)
  121.                (SETVAR (CAAR MLST) (CADAR MLST))
  122.                (SETQ MLST (CDR MLST))))
  123.  
  124. (princ "\rPlease wait- loading.. \|")
  125.  
  126. (DEFUN LINE? (ENM) ;; takes an entity name as its argument
  127.        (IF (AND ENM (= (CDR (ASSOC 0 (ENTGET ENM))) "LINE"))
  128.            'T
  129.            (PROGN (PRINC "\nWall entities must be lines.") nil)))
  130.  
  131. (princ "\rPlease wait- loading.. \/")
  132.  
  133. (PRINC "\r2 pick door command C:DOOR loaded.  Type DOOR to begin.")
  134. (PRINC)
  135.  
  136.