home *** CD-ROM | disk | FTP | other *** search
/ Windows 95 v2.4 Fix / W95-v2.4fix.iso / ACADWIN / SUPPORT / DDGRIPS.LSP < prev    next >
Encoding:
Lisp/Scheme  |  1995-02-08  |  9.8 KB  |  296 lines
  1. ; Next available MSG number is    14 
  2. ; MODULE_ID DDGRIPS_LSP_
  3. ;;;
  4. ;;;    ddgrips.lsp
  5. ;;;
  6. ;;;    Copyright (C) 1992, 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. ;;; ===================== load-time error checking ============================
  28. ;;;
  29.  
  30.   (defun ai_abort (app msg)
  31.      (defun *error* (s)
  32.         (if old_error (setq *error* old_error))
  33.         (princ)
  34.      )
  35.      (if msg
  36.        (alert (strcat " Error en la aplicaciā‰¤n: "
  37.                       app
  38.                       " \n\n  "
  39.                       msg
  40.                       "  \n"
  41.               )
  42.        )
  43.      )
  44.      (exit)
  45.   )
  46.  
  47. ;;; Check to see if AI_UTILS is loaded, If not, try to find it,
  48. ;;; and then try to load it.
  49. ;;;
  50. ;;; If it can't be found or it can't be loaded, then abort the
  51. ;;; loading of this file immediately, preserving the (autoload)
  52. ;;; stub function.
  53.  
  54.   (cond
  55.      (  (and ai_dcl (listp ai_dcl)))          ; it's already loaded.
  56.  
  57.      (  (not (findfile ;|MSG0|;"ai_utils.lsp"))                     ; find it
  58.         (ai_abort "DDGRIPS"
  59.                   (strcat "Imposible localizar el archivo AI_UTILS.LSP."
  60.                           "\n Compruebe el directorio de soporte.")))
  61.  
  62.      (  (eq ;|MSG0|;"failed" (load "ai_utils" ;|MSG0|;"failed"))            ; load it
  63.         (ai_abort "DDGRIPS" "Imposible cargar el archivo AI_UTILS.LSP"))
  64.   )
  65.  
  66.   (if (not (ai_acadapp))               ; defined in AI_UTILS.LSP
  67.       (ai_abort "DDGRIPS" nil)         ; a Nil <msg> supresses
  68.   )                                    ; ai_abort's alert box dialog.
  69.  
  70. ;;; ==================== end load-time operations ===========================
  71.  
  72. ;;;----------------------------------------------------------------------------
  73. ;;; The Main routine.
  74. ;;;----------------------------------------------------------------------------
  75. (defun c:ddgrips( /
  76.                   do_cool        gripcolor      x1             grips_var
  77.                   cmd            gripsize       x2             gripblock_var
  78.                   cnum           do_hot         hotcolor       x_grip    
  79.                   colorint       image_col      x_swatch  
  80.                   coolcolor      do_setvars     y_grip    
  81.                   dcl_id         draw_size      temp_color     y_swatch  
  82.                   globals        whichgrip      ddgrips_main   what_next
  83.                   gripsize_init  hotcolor_init  coolcolor_init 
  84.                   gripblock_init grips_init     undo_init
  85.                 )
  86.   ;;
  87.   ;; Disable gripblock when grips are disabled.
  88.   ;;
  89.   (defun grips()
  90.     (if (= "1" (get_tile ;|MSG0|;"grips")) 
  91.       (mode_tile ;|MSG0|;"gripblock" 0) 
  92.       (mode_tile ;|MSG0|;"gripblock" 1)
  93.     )
  94.   )
  95.   ;;
  96.   ;; Pass an integer and draw a square of that size in the gripsize image tile.
  97.   ;; 
  98.   (defun draw_size (intsize)
  99.     (setq x1 (- (/ x_grip 2) (1+ intsize) ))
  100.     (setq x2 (+ (/ x_grip 2) (1+ intsize) ))
  101.     (setq y1 (- (/ y_grip 2) (1+ intsize) ))
  102.     (setq y2 (+ (/ y_grip 2) (1+ intsize) ))
  103.     (start_image ;|MSG0|;"grip_image")
  104.     (fill_image 0 0 x_grip y_grip -2)
  105.     (vector_image x1 y1 x2 y1 coolcolor)
  106.     (vector_image x2 y1 x2 y2 coolcolor)
  107.     (vector_image x2 y2 x1 y2 coolcolor)
  108.     (vector_image x1 y2 x1 y1 coolcolor)
  109.     (end_image)
  110.   )
  111.   ;;
  112.   ;;  Select cool color from color dialogue.
  113.   ;;
  114.   (defun do_cool()
  115.     (if (setq temp_color (acad_colordlg coolcolor nil))
  116.       (progn 
  117.         (setq coolcolor temp_color)
  118.         (set_tile ;|MSG0|;"cool_text" (gripcolor coolcolor ;|MSG0|;"cool"))
  119.         (start_image ;|MSG0|;"cool_image")
  120.         (fill_image 0 0 x_swatch y_swatch (image_col coolcolor ;|MSG0|;"cool"))
  121.         (end_image)
  122.         (draw_size gripsize)
  123.       )
  124.     )
  125.   )
  126.   ;; 
  127.   ;;  Select cool color from color dialogue.
  128.   ;;
  129.   (defun do_hot()
  130.     (if (setq temp_color (acad_colordlg hotcolor nil))
  131.       (progn 
  132.         (setq hotcolor temp_color)
  133.         (set_tile ;|MSG0|;"hot_text" (gripcolor hotcolor ;|MSG0|;"hot"))
  134.         (start_image ;|MSG0|;"hot_image")
  135.         (fill_image  0  0  x_swatch y_swatch (image_col hotcolor ;|MSG0|;"hot"))
  136.         (end_image)
  137.       )
  138.     )
  139.   )
  140.   ;;
  141.   ;; If color is zero pass correct color number.
  142.   ;;
  143.   (defun image_col(colorint whichgrip)
  144.      (cond
  145.        ((and (= 0 colorint) (= whichgrip ;|MSG0|;"cool")) 5)
  146.        ((and (= 0 colorint) (= whichgrip ;|MSG0|;"hot")) 1)
  147.        (t colorint)
  148.     )
  149.   )
  150.   ;;
  151.   ;; Pass an integer and recieve a string stating the color name if it is
  152.   ;; one of AutoCAD's standard colors, else just a string containing the 
  153.   ;; number.
  154.   ;;
  155.   (defun gripcolor(colorint whichgrip)
  156.      (cond
  157.        ((and (= 0 colorint) (= whichgrip ;|MSG0|;"cool")) ;|MSG0|;"5 - Blue")
  158.        ((and (= 0 colorint) (= whichgrip ;|MSG0|;"hot")) ;|MSG0|;"1 - Red")
  159.        ((= 1 colorint) "1 - Rojo")
  160.        ((= 2 colorint) "2 - Amarillo")
  161.        ((= 3 colorint) "3 - Verde")
  162.        ((= 4 colorint) "4 - Ciano")
  163.        ((= 5 colorint) "5 - Azul")
  164.        ((= 6 colorint) "6 - Magenta")
  165.        ((= 7 colorint) "7 - Blanco")
  166.        (t (itoa colorint))
  167.      )
  168.   )
  169.   ;;
  170.   ;;  If OK, set all setvars to selected values.
  171.   ;;
  172.   (defun do_setvars()
  173.     (if (/= grips_var grips_init)
  174.       (setvar "grips" (atoi grips_var))
  175.     )
  176.     (if (/= gripblock_var gripblock_init)
  177.       (setvar "gripblock" (atoi gripblock_var))
  178.     )
  179.     (if (/= coolcolor coolcolor_init)
  180.       (setvar "gripcolor" coolcolor)
  181.     )
  182.     (if (/= hotcolor hotcolor_init)
  183.       (setvar "griphot" hotcolor)
  184.     )
  185.     (if (/= gripsize gripsize_init)
  186.       (setvar "gripsize" (1+ gripsize))
  187.     )
  188.   )
  189.   ;;
  190.   ;; Put up the dialogue.
  191.   ;;
  192.   (defun ddgrips_main()
  193.  
  194.     (if (not (new_dialog ;|MSG0|;"ddgrips" dcl_id)) (exit))
  195.  
  196.     (setq coolcolor (getvar "gripcolor")
  197.           coolcolor_init coolcolor     ; remember initial value
  198.           hotcolor (getvar "griphot")
  199.           hotcolor_init hotcolor       ; remember initial value
  200.     )
  201.  
  202.     ;; Get current settings of variables.
  203.     (set_tile ;|MSG0|;"grips" (setq grips_init (itoa (getvar "grips"))))
  204.     (set_tile ;|MSG0|;"gripblock" (setq gripblock_init (itoa (getvar "gripblock"))))
  205.  
  206.     (setq grips_var grips_init)
  207.     (setq gripblock_var gripblock_init)
  208.  
  209.     (grips)
  210.  
  211.     (set_tile ;|MSG0|;"cool_text" (gripcolor coolcolor ;|MSG0|;"cool"))
  212.     (set_tile ;|MSG0|;"hot_text" (gripcolor hotcolor ;|MSG0|;"hot"))
  213.  
  214.     ;; The gripsize variable must be within 1 - 20 for display within the image 
  215.     ;; tile.  The gripsize variable will only be updated if the user moves
  216.     ;; the slider bar (0 - 19).
  217.     (setq gripsize (1- (getvar "gripsize")))
  218.  
  219.     (if (< 19 gripsize) (setq gripsize 19))
  220.     (if (> 0 gripsize) (setq gripsize 0))
  221.     (setq gripsize_init gripsize)
  222.  
  223.  
  224.     (set_tile ;|MSG0|;"grip_slider" (itoa gripsize))
  225.  
  226.     (setq x_swatch (dimx_tile ;|MSG0|;"cool_image"))
  227.     (setq y_swatch (dimy_tile ;|MSG0|;"cool_image"))
  228.  
  229.     (setq x_grip (dimx_tile ;|MSG0|;"grip_image"))
  230.     (setq y_grip (dimy_tile ;|MSG0|;"grip_image"))
  231.  
  232.     (start_image ;|MSG0|;"cool_image")
  233.     (fill_image  0  0  x_swatch y_swatch (image_col coolcolor ;|MSG0|;"cool"))
  234.     (end_image)
  235.  
  236.     (start_image ;|MSG0|;"hot_image")
  237.     (fill_image  0  0  x_swatch y_swatch (image_col hotcolor ;|MSG0|;"hot"))
  238.     (end_image)
  239.  
  240.     (draw_size gripsize)
  241.  
  242.     (action_tile ;|MSG0|;"default_mode" "(set_default)")
  243.     (action_tile ;|MSG0|;"grips" "(setq grips_var $value)(grips)")
  244.     (action_tile ;|MSG0|;"gripblock" "(setq gripblock_var $value)")
  245.     (action_tile ;|MSG0|;"cool_color" "(do_cool)")
  246.     (action_tile ;|MSG0|;"hot_color" "(do_hot)")
  247.     (action_tile ;|MSG0|;"grip_slider" "(draw_size (setq gripsize (atoi $value)))")
  248.     (action_tile ;|MSG0|;"help" "(help \"\" \"ddgrips\")")
  249.     (action_tile ;|MSG0|;"accept" "(done_dialog 1)")
  250.  
  251.     (setq what_next (start_dialog))
  252.  
  253.     (cond 
  254.       ((= 1 what_next)
  255.         (do_setvars)
  256.       )
  257.     )
  258.   )
  259.  
  260.   ;; Set up error function.
  261.   (setq old_cmd (getvar "cmdecho")    ; save current setting of cmdecho
  262.         old_error  *error*            ; save current error function
  263.         *error* ai_error              ; new error function
  264.   )
  265.  
  266.   (setvar "cmdecho" 0)
  267.  
  268.   (cond
  269.      (  (not (ai_transd)))                       ; transparent OK
  270.      (  (not (ai_acadapp)))                      ; ACADAPP.EXP xloaded?
  271.      (  (not (setq dcl_id (ai_dcl ;|MSG0|;"ddgrips"))))  ; is .DCL file loaded?
  272.      (t (if (and (/= 1 (logand 1 (getvar "cmdactive")))
  273.                  (/= 8 (logand 8 (getvar "cmdactive")))
  274.             )
  275.          (ai_undo_push)
  276.         )
  277.         (ddgrips_main)                           ; proceed!
  278.         (if (and (/= 1 (logand 1 (getvar "cmdactive")))
  279.                  (/= 8 (logand 8 (getvar "cmdactive")))
  280.             )
  281.          (ai_undo_pop)
  282.         )        
  283.      )
  284.   )
  285.  
  286.  
  287.   (setq *error* old_error) 
  288.   (setvar "cmdecho" old_cmd)
  289.   (princ)
  290. )
  291. ;;;----------------------------------------------------------------------------
  292. (princ "  DDGRIPS cargada.")
  293. (princ)
  294.  
  295.  
  296.