home *** CD-ROM | disk | FTP | other *** search
/ Windows 95 v2.4 Fix / W95-v2.4fix.iso / ACADWIN / SUPPORT / DDOSNAP.LSP < prev    next >
Encoding:
Lisp/Scheme  |  1995-02-08  |  8.5 KB  |  253 lines
  1. ; Next available MSG number is     7 
  2. ; MODULE_ID DDOSNAP_LSP_
  3. ;;;----------------------------------------------------------------------------
  4. ;;;    DDOSNAP.LSP  Version 0.5
  5. ;;;
  6. ;;;    Copyright (C) 1991, 1992, 1993, 1994 by Autodesk, Inc.
  7. ;;;
  8. ;;;    Permission to use, copy, modify, and distribute this software
  9. ;;;    for any purpose and without fee is hereby granted, provided
  10. ;;;    that the above copyright notice appears in all copies and
  11. ;;;    that both that copyright notice and the limited warranty and
  12. ;;;    restricted rights notice below appear in all supporting
  13. ;;;    documentation.
  14. ;;;
  15. ;;;    AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.
  16. ;;;    AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF
  17. ;;;    MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE.  AUTODESK, INC.
  18. ;;;    DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
  19. ;;;    UNINTERRUPTED OR ERROR FREE.
  20. ;;;
  21. ;;;    Use, duplication, or disclosure by the U.S. Government is subject to
  22. ;;;    restrictions set forth in FAR 52.227-19 (Commercial Computer
  23. ;;;    Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii) 
  24. ;;;    (Rights in Technical Data and Computer Software), as applicable.
  25. ;;;
  26. ;;;.
  27. ;;;----------------------------------------------------------------------------
  28. ;;;
  29. ;;; ===========================================================================
  30. ;;; ===================== load-time error checking ============================
  31. ;;;
  32.  
  33.   (defun ai_abort (app msg)
  34.      (defun *error* (s)
  35.         (if old_error (setq *error* old_error))
  36.         (princ)
  37.      )
  38.      (if msg
  39.        (alert (strcat " Error en la aplicaciā‰¤n: "
  40.                       app
  41.                       " \n\n  "
  42.                       msg
  43.                       "  \n"
  44.               )
  45.        )
  46.      )
  47.      (exit)
  48.   )
  49.  
  50. ;;; Check to see if AI_UTILS is loaded, If not, try to find it,
  51. ;;; and then try to load it.
  52. ;;;
  53. ;;; If it can't be found or it can't be loaded, then abort the
  54. ;;; loading of this file immediately, preserving the (autoload)
  55. ;;; stub function.
  56.  
  57.   (cond
  58.      (  (and ai_dcl (listp ai_dcl)))          ; it's already loaded.
  59.  
  60.      (  (not (findfile "ai_utils.lsp"))                     ; find it
  61.         (ai_abort "DDOSNAP"
  62.                   (strcat "Imposible localizar el archivo AI_UTILS.LSP."
  63.                           "\n Compruebe el directorio de soporte.")))
  64.  
  65.      (  (eq "failed" (load "ai_utils" "failed"))            ; load it
  66.         (ai_abort "DDOSNAP" "Imposible cargar el archivo AI_UTILS.LSP"))
  67.   )
  68.  
  69.   (if (not (ai_acadapp))               ; defined in AI_UTILS.LSP
  70.       (ai_abort "DDOSNAP" nil)         ; a Nil <msg> supresses
  71.   )                                    ; ai_abort's alert box dialog.
  72.  
  73. ;;; ==================== end load-time operations ===========================
  74.  
  75. ;;;----------------------------------------------------------------------------
  76. ;;; The main routine.
  77. ;;;----------------------------------------------------------------------------
  78. (defun c:ddosnap( /
  79.                   ap_size          ddosnap_main    olderr         x2         
  80.                   cmd              do_setvars      osmode         x_aperture 
  81.                   dcl_id           draw_size       osmode_init    y_aperture 
  82.                   ddosnap_err      globals         x1             ap_size_init
  83.                   undo_init
  84.                 )
  85.   ;;
  86.   ;; Pass an integer and draw a square of that size in the aperture image tile.
  87.   ;; 
  88.   (defun draw_size (intsize)
  89.     (setq x1 (- (/ x_aperture 2) (1+ intsize) ))
  90.     (setq x2 (+ (/ x_aperture 2) (1+ intsize) ))
  91.     (setq y1 (- (/ y_aperture 2) (1+ intsize) ))
  92.     (setq y2 (+ (/ y_aperture 2) (1+ intsize) ))
  93.     (start_image "aperture_image")
  94.     (fill_image 0 0 x_aperture y_aperture -2)
  95.     (vector_image x1 y1 x2 y1 -1)
  96.     (vector_image x2 y1 x2 y2 -1)
  97.     (vector_image x2 y2 x1 y2 -1)
  98.     (vector_image x1 y2 x1 y1 -1)
  99.     (end_image)
  100.   )
  101.   ;;
  102.   ;;  If OK, set setvars to selected values.
  103.   ;;
  104.   (defun do_setvars()
  105.     (setq osmode 0)
  106.     (if (= "1" (get_tile "endpoint")) 
  107.       (setq osmode (logior osmode 1))
  108.     )
  109.     (if (= "1" (get_tile "midpoint")) 
  110.       (setq osmode (logior osmode 2))
  111.     )
  112.     (if (= "1" (get_tile "center")) 
  113.       (setq osmode (logior osmode 4))
  114.     )
  115.     (if (= "1" (get_tile "node")) 
  116.       (setq osmode (logior osmode 8))
  117.     )
  118.     (if (= "1" (get_tile "quadrant")) 
  119.       (setq osmode (logior osmode 16))
  120.     )
  121.     (if (= "1" (get_tile "intersection")) 
  122.       (setq osmode (logior osmode 32))
  123.     )
  124.     (if (= "1" (get_tile "insertion")) 
  125.       (setq osmode (logior osmode 64))
  126.     )
  127.     (if (= "1" (get_tile "perpendicular")) 
  128.       (setq osmode (logior osmode 128))
  129.     )
  130.     (if (= "1" (get_tile "tangent")) 
  131.       (setq osmode (logior osmode 256))
  132.     )
  133.     (if (= "1" (get_tile "nearest")) 
  134.       (setq osmode (logior osmode 512))
  135.     )
  136.     (if (= "1" (get_tile "quick")) 
  137.       (setq osmode (logior osmode 1024))
  138.     )
  139.     (if (= "1" (get_tile "apint")) 
  140.       (setq osmode (logior osmode 2048))
  141.     )
  142.     (if (/= osmode osmode_init)
  143.       (setvar "osmode" osmode)
  144.     )
  145.     (if (/= ap_size ap_size_init)
  146.       (setvar "aperture" (1+ ap_size))
  147.     )
  148.   )
  149.   ;;
  150.   ;; Clears all the osmodes.
  151.   ;;
  152.   (defun clear_osmodes()
  153.     (set_tile "endpoint" "0")
  154.     (set_tile "midpoint" "0")
  155.     (set_tile "center" "0")
  156.     (set_tile "node" "0")
  157.     (set_tile "quadrant" "0")
  158.     (set_tile "intersection" "0")
  159.     (set_tile "insertion" "0")
  160.     (set_tile "perpendicular" "0")
  161.     (set_tile "tangent" "0")
  162.     (set_tile "nearest" "0")
  163.     (set_tile "quick" "0")
  164.     (set_tile "apint" "0")
  165.   )
  166.   ;;
  167.   ;; Put up the dialogue.
  168.   ;;
  169.   (defun ddosnap_main()
  170.  
  171.     (if (not (new_dialog "ddosnap" dcl_id)) (exit))
  172.  
  173.     ;; The aperture variable must be within 1 - 20 for display within the image 
  174.     ;; tile.  The aperture variable will only be updated if the user moves
  175.     ;; the slider bar (0 - 19).
  176.     (setq ap_size (1- (getvar "aperture")))
  177.     (if (< 19 ap_size) (setq ap_size 19))
  178.     (if (> 0 ap_size) (setq ap_size 0))
  179.     (setq ap_size_init ap_size)
  180.  
  181.     (setq x_aperture (dimx_tile "aperture_image"))
  182.     (setq y_aperture (dimy_tile "aperture_image"))
  183.  
  184.     (set_tile "aperture_slider" (itoa ap_size))
  185.  
  186.     (draw_size ap_size)
  187.  
  188.     (setq osmode_init (getvar "osmode")   ; get initial value of variable
  189.           osmode      osmode_init
  190.     )
  191.     (if (= 1 (logand 1 osmode)) (set_tile "endpoint" "1"))
  192.     (if (= 2 (logand 2 osmode)) (set_tile "midpoint" "1"))
  193.     (if (= 4 (logand 4 osmode)) (set_tile "center" "1"))
  194.     (if (= 8 (logand 8 osmode)) (set_tile "node" "1"))
  195.     (if (= 16 (logand 16 osmode)) (set_tile "quadrant" "1"))
  196.     (if (= 32 (logand 32 osmode)) (set_tile "intersection" "1"))
  197.     (if (= 64 (logand 64 osmode)) (set_tile "insertion" "1"))
  198.     (if (= 128 (logand 128 osmode)) (set_tile "perpendicular" "1"))
  199.     (if (= 256 (logand 256 osmode)) (set_tile "tangent" "1"))
  200.     (if (= 512 (logand 512 osmode)) (set_tile "nearest" "1"))
  201.     (if (= 1024 (logand 1024 osmode)) (set_tile "quick" "1"))
  202.     (if (= 2048 (logand 2048 osmode)) (set_tile "apint" "1"))
  203.  
  204.     (action_tile "clear" "(clear_osmodes)") 
  205.     (action_tile "aperture_slider" 
  206.                  "(draw_size (setq ap_size (atoi $value)))")
  207.     (action_tile "help" "(help \"\" \"ddosnap\")")
  208.     (action_tile "accept" "(do_setvars)(done_dialog 1)")
  209.  
  210.     (start_dialog)
  211.   )
  212.  
  213.   ;; Set up error function.
  214.   (setq old_cmd (getvar "cmdecho")    ; save current setting of cmdecho
  215.         old_error  *error*            ; save current error function
  216.         *error* ai_error              ; new error function
  217.   )
  218.  
  219.   (setvar "cmdecho" 0)
  220.  
  221.   (cond
  222.      (  (not (ai_transd)))                       ; transparent OK
  223.      (  (not (ai_acadapp)))                      ; ACADAPP.EXP xloaded?
  224.      (  (not (setq dcl_id (ai_dcl "ddosnap"))))  ; is .DCL file loaded?
  225.  
  226.      (t (if (and (/= 1 (logand 1 (getvar "cmdactive")))
  227.                  (/= 8 (logand 8 (getvar "cmdactive")))
  228.             )
  229.          (ai_undo_push)
  230.         )
  231.  
  232.         (ddosnap_main)                          ; proceed!
  233.  
  234.         (if (and (/= 1 (logand 1 (getvar "cmdactive")))
  235.                  (/= 8 (logand 8 (getvar "cmdactive")))
  236.             )
  237.          (ai_undo_pop)
  238.         )        
  239.  
  240.      )
  241.   )
  242.  
  243.  
  244.   (setq *error* old_error) 
  245.   (setvar "cmdecho" old_cmd)
  246.   (princ)
  247. )
  248. ;;;----------------------------------------------------------------------------
  249. (princ "  DDOSNAP cargada.")
  250. (princ)
  251.  
  252.  
  253.