home *** CD-ROM | disk | FTP | other *** search
/ Windows 95 v2.4 Fix / W95-v2.4fix.iso / ACADWIN / SUPPORT / DDSELECT.LSP < prev    next >
Encoding:
Lisp/Scheme  |  1995-02-08  |  9.5 KB  |  273 lines
  1. ; Next available MSG number is     7 
  2. ; MODULE_ID DDSELECT_LSP_
  3. ;;;----------------------------------------------------------------------------
  4. ;;;    DDSELECT.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. ;;; ===========================================================================
  31. ;;; ===================== load-time error checking ============================
  32. ;;;
  33.  
  34.   (defun ai_abort (app msg)
  35.      (defun *error* (s)
  36.         (if old_error (setq *error* old_error))
  37.         (princ)
  38.      )
  39.      (if msg
  40.        (alert (strcat " Error en la aplicaciā‰¤n: "
  41.                       app
  42.                       " \n\n  "
  43.                       msg
  44.                       "  \n"
  45.               )
  46.        )
  47.      )
  48.      (exit)
  49.   )
  50.  
  51. ;;; Check to see if AI_UTILS is loaded, If not, try to find it,
  52. ;;; and then try to load it.
  53. ;;;
  54. ;;; If it can't be found or it can't be loaded, then abort the
  55. ;;; loading of this file immediately, preserving the (autoload)
  56. ;;; stub function.
  57.  
  58.   (cond
  59.      (  (and ai_dcl (listp ai_dcl)))          ; it's already loaded.
  60.  
  61.      (  (not (findfile "ai_utils.lsp"))                     ; find it
  62.         (ai_abort "DDSELECT"
  63.                   (strcat "Imposible localizar el archivo AI_UTILS.LSP."
  64.                           "\n Compruebe el directorio de soporte.")))
  65.  
  66.      (  (eq "failed" (load "ai_utils" "failed"))            ; load it
  67.         (ai_abort "DDSELECT" "Imposible cargar el archivo AI_UTILS.LSP"))
  68.   )
  69.  
  70.   (if (not (ai_acadapp))               ; defined in AI_UTILS.LSP
  71.       (ai_abort "DDSELECT" nil)         ; a Nil <msg> supresses
  72.   )                                    ; ai_abort's alert box dialog.
  73.  
  74. ;;; ==================== end load-time operations ===========================
  75.  
  76. ;;;----------------------------------------------------------------------------
  77. ;;; The main routine.
  78. ;;;----------------------------------------------------------------------------
  79. (defun c:ddselect( /
  80.                    cmd             draw_size       set_default     x2         
  81.                    dcl_id          ent_sort        set_sort        x_pickbox  
  82.                    globals         sortents        y_pickbox       undo_init
  83.                    sortents_init   ddselect_main
  84.                    do_setvars      pickboxsize     x1              
  85.                    pickfirst_init  pickadd_init    pickdrag_init    
  86.                    pickauto_init   pickboxsize_init groups_init    hatch
  87.                  )
  88.   ;;
  89.   ;; Pass an integer and draw a square of that size in the pickboxsize 
  90.   ;; image tile.
  91.   ;; 
  92.   (defun draw_size (intsize)
  93.     (setq x1 (- (/ x_pickbox 2) (1+ intsize) ))
  94.     (setq x2 (+ (/ x_pickbox 2) (1+ intsize) ))
  95.     (setq y1 (- (/ y_pickbox 2) (1+ intsize) ))
  96.     (setq y2 (+ (/ y_pickbox 2) (1+ intsize) ))
  97.     (start_image "pickbox_image")
  98.     (fill_image 0 0 x_pickbox y_pickbox -2)  ; -2 is the graphics screen color
  99.     (vector_image x1 y1 x2 y1 -1)            ; -1 is the cursor color
  100.     (vector_image x2 y1 x2 y2 -1)
  101.     (vector_image x2 y2 x1 y2 -1)
  102.     (vector_image x1 y2 x1 y1 -1)
  103.     (end_image)
  104.   )
  105.   ;;
  106.   ;; Set the SORTENTS system variable to selected setting.
  107.   ;;
  108.   (defun set_sort()
  109.     (setq sortents 0)             ; initialise to 0.
  110.     (if (= "1" (get_tile "sort_obj_sel")) 
  111.       (setq sortents (logior sortents 1))
  112.     )
  113.     (if (= "1" (get_tile "sort_obj_snap")) 
  114.       (setq sortents (logior sortents 2))
  115.     )
  116.     (if (= "1" (get_tile "sort_redraws")) 
  117.       (setq sortents (logior sortents 4))
  118.     )
  119.     (if (= "1" (get_tile "sort_slide")) 
  120.       (setq sortents (logior sortents 8))
  121.     )
  122.     (if (= "1" (get_tile "sort_regens")) 
  123.       (setq sortents (logior sortents 16))
  124.     )
  125.     (if (= "1" (get_tile "sort_plot")) 
  126.       (setq sortents (logior sortents 32))
  127.     )
  128.     (if (= "1" (get_tile "sort_post")) 
  129.       (setq sortents (logior sortents 64))
  130.     )
  131.     (setq sortents sortents)
  132.   )
  133.   ;;
  134.   ;;  The entity sort dialogue.
  135.   ;;
  136.   (defun ent_sort()
  137.     (if (not (new_dialog "sortents" dcl_id)) (exit))
  138.     ;; Display current settings.
  139.     (if (= 1 (logand 1 sortents)) (set_tile "sort_obj_sel" "1"))
  140.     (if (= 2 (logand 2 sortents)) (set_tile "sort_obj_snap" "1"))
  141.     (if (= 4 (logand 4 sortents)) (set_tile "sort_redraws" "1"))
  142.     (if (= 8 (logand 8 sortents)) (set_tile "sort_slide" "1"))
  143.     (if (= 16 (logand 16 sortents)) (set_tile "sort_regens" "1"))
  144.     (if (= 32 (logand 32 sortents)) (set_tile "sort_plot" "1"))
  145.     (if (= 64 (logand 64 sortents)) (set_tile "sort_post" "1"))
  146.   
  147.     (action_tile "accept" "(set_sort)(done_dialog 1)")
  148.     (start_dialog)
  149.   )
  150.   ;;
  151.   ;;  If OK, set all setvars to selected values.
  152.   ;;
  153.   (defun do_setvars()
  154.     (if (/= pickfirst_init (get_tile "pickfirst"))
  155.       (setvar "pickfirst" (atoi (get_tile "pickfirst")))
  156.     )
  157.     (if (/= pickadd_init (get_tile "pickadd"))
  158.       (setvar "pickadd" (abs (- 1 (atoi (get_tile "pickadd")))))
  159.     )
  160.     (if (/= pickdrag_init (get_tile "pickdrag"))
  161.       (setvar "pickdrag" (atoi (get_tile "pickdrag")))
  162.     )
  163.     (if (/= pickauto_init (get_tile "pickauto"))
  164.       (setvar "pickauto" (atoi (get_tile "pickauto")))
  165.     )
  166.     (if (/= groups_init (get_tile "grouping"))
  167.       (setvar "pickstyle" (+ (atoi (get_tile "grouping")) hatch))
  168.     )
  169.     (if (/= pickboxsize_init pickboxsize)
  170.       (setvar "pickbox" (1+ pickboxsize))
  171.     )
  172.     ; Also set the sortents sysvar, if it has been modified.
  173.     (if (/= sortents sortents_init) 
  174.       (setvar "sortents" sortents)
  175.     )
  176.   )
  177.   ;;
  178.   ;;  Set all toggles to default mode.
  179.   ;; 
  180.   (defun set_default()
  181.     (set_tile "pickfirst" "1")
  182.     (set_tile "pickadd" "0")         ; label is titled opposite to the setvar.
  183.     (set_tile "pickdrag" "0")
  184.     (set_tile "pickauto" "1")
  185.     (set_tile "grouping" "1")
  186.   )
  187.   ;;
  188.   ;; Put up the dialogue.
  189.   ;;
  190.   (defun ddselect_main()
  191.  
  192.     (if (not (new_dialog "ddselect" dcl_id)) (exit))
  193.  
  194.     ;; Get the value of the SORTENTS system variable.
  195.     (setq sortents_init (getvar "sortents")
  196.           sortents     sortents_init
  197.     )
  198.  
  199.     ;; The pickbox variable must be within 1 - 20 for display within the image 
  200.     ;; tile.  The pickbox variable will only be updated if the user moves
  201.     ;; the slider bar (0 - 19).
  202.     (setq pickboxsize (1- (getvar "pickbox")))
  203.     (if (< 19 pickboxsize) (setq pickboxsize 19))
  204.     (if (> 0 pickboxsize) (setq pickboxsize 0))
  205.     (setq pickboxsize_init pickboxsize)
  206.  
  207.     ;; Get current settings of variables.
  208.     (setq hatch (logand (getvar "pickstyle") 2)) 
  209.     (set_tile "pickfirst" (setq pickfirst_init (itoa (getvar "pickfirst"))))
  210.     (set_tile "pickadd" 
  211.               (setq pickadd_init (itoa (abs (- 1 (getvar "pickadd"))))))
  212.     (set_tile "pickdrag" (setq pickdrag_init (itoa (getvar "pickdrag"))))
  213.     (set_tile "pickauto" (setq pickauto_init (itoa (getvar "pickauto"))))
  214.     (set_tile "grouping" (setq groups_init   (itoa (logand (getvar "pickstyle") 1))))
  215.     (set_tile "pickbox_slider" (itoa pickboxsize))
  216.  
  217.     (setq x_pickbox (dimx_tile "pickbox_image"))
  218.     (setq y_pickbox (dimy_tile "pickbox_image"))
  219.  
  220.     (draw_size pickboxsize)
  221.  
  222.     (action_tile "default_mode" "(set_default)")
  223.  
  224.     (action_tile "pickbox_slider" 
  225.                  "(draw_size (setq pickboxsize (atoi $value)))")
  226.     (action_tile "ent_sort" "(ent_sort)")
  227.     (action_tile "help" "(help \"\" \"ddselect\")")
  228.     (action_tile "accept" "(do_setvars)(done_dialog 1)")
  229.  
  230.     (start_dialog)
  231.   )
  232.  
  233.   ;; Set up error function.
  234.   (setq old_cmd (getvar "cmdecho")    ; save current setting of cmdecho
  235.         old_error  *error*            ; save current error function
  236.         *error* ai_error              ; new error function
  237.   )
  238.  
  239.   (setvar "cmdecho" 0)
  240.  
  241.   (cond
  242.      (  (not (ai_transd)))                        ; transparent OK
  243.      (  (not (ai_acadapp)))                       ; ACADAPP.EXP xloaded?
  244.      (  (not (setq dcl_id (ai_dcl "ddselect"))))  ; is .DCL file loaded?
  245.  
  246.      (t (if (and (/= 1 (logand 1 (getvar "cmdactive")))
  247.                  (/= 8 (logand 8 (getvar "cmdactive")))
  248.             )
  249.          (ai_undo_push)
  250.         )
  251.  
  252.         (ddselect_main)                          ; proceed!
  253.  
  254.         (if (and (/= 1 (logand 1 (getvar "cmdactive")))
  255.                  (/= 8 (logand 8 (getvar "cmdactive")))
  256.             )
  257.          (ai_undo_pop)
  258.         )        
  259.  
  260.      )
  261.   )
  262.  
  263.   (setq *error* old_error) 
  264.   (setvar "cmdecho" old_cmd)
  265.   (princ)
  266. )
  267.  
  268. ;;;----------------------------------------------------------------------------
  269. (princ "  DDSELECT cargada.")
  270. (princ)
  271.  
  272.  
  273.