home *** CD-ROM | disk | FTP | other *** search
/ Windows 95 v2.4 Fix / W95-v2.4fix.iso / ACADWIN / SAMPLE / DLGTEST.LSP < prev    next >
Encoding:
Lisp/Scheme  |  1995-02-08  |  7.2 KB  |  237 lines
  1. ;;;------------------------------------------------------------------------
  2. ;;;   DLGTEST.LSP
  3. ;;;   (C) Copyright 1990-1994 by Autodesk, Inc.
  4. ;;;
  5. ;;;   Permission to use, copy, modify, and distribute this software and its
  6. ;;;   documentation for any purpose and without fee is hereby granted.
  7. ;;;
  8. ;;;   THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED
  9. ;;;   WARRANTY. ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR
  10. ;;;   PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED.
  11. ;;;
  12. ;;;------------------------------------------------------------------------
  13. ;
  14. ;
  15. ; Programmable Dialog Box Test Program
  16. ;
  17. ; This program is the AutoLISP counterpart to the ADS test
  18. ; program, dlgtest.c.  It provides a simple dimensioning
  19. ; dialog invoked with the command "dimen" and a simple color
  20. ; dialog invoked with the command "setcolor".
  21. ;
  22. ; The purposes of providing this program:
  23. ; 1) Demonstrate Programmable Dialog Box use with minimum of code
  24. ;       to sort through
  25. ; 2) Demonstrate differences between LISP and ADS dialog programming
  26. ; 3) Use as a starting point for testing new dialog functions
  27. ;
  28. ; Dlgtest uses the file dlgtest.dcl as the DCL (Dialog Control Language) file.
  29. ; LISP functions are associated with dialog tiles (buttons, edit boxes,
  30. ;   etc) with the "action_tile" statements.  These actions are evaluated 
  31. ;   when the user presses buttons during the start_dialog function.
  32. ;
  33. ; Special tile names (keys): 
  34. ;   "accept" - Ok button
  35. ;   "cancel" - Cancel button
  36.  
  37. ; Initialization--set the dialog position to default (centered).  
  38. ;   Only required if you want to reposition it where the user last left it.
  39. (setq dim_pos '(-1 -1))
  40.  
  41. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  42. ;
  43. ; DIMEN -- AutoCAD dimensioning variables.  Set AutoCAD variables 
  44. ;   only if OK pressed, by defining the action for the "accept"
  45. ;   tile.
  46. ;
  47. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  48.  
  49. (defun c:dimen ( / chklist realist)
  50.   ;load DCL file
  51.   (setq di_dcl_id (load_dialog "dlgtest.dcl"))
  52.   (if (< di_dcl_id 0) (exit))
  53.  
  54.   ; display dialog
  55.   (if (not (new_dialog "dimensions" di_dcl_id "" dim_pos)) (exit))
  56.  
  57.   ; Create list of button names to match AutoCAD variables
  58.   (setq chklist '("dimse1"  "dimse2" "dimtih" "dimtoh" "dimtad"  "dimtol"
  59.             "dimlim"  "dimalt" "dimaso" "dimsho")
  60.   )
  61.   (setq realist '("dimasz" "dimtsz" "dimtxt" "dimcen" "dimexo" "dimexe"
  62.             "dimdle")
  63.   )
  64.   ; Send the current value of AutoCAD variables to the dialog
  65.   (mapcar 'set_tile_int chklist)
  66.   (mapcar 'set_tile_real realist)
  67.  
  68.  
  69.   ; Define the action to take when the user presses OK, which
  70.   ;   is to call the LISP function "dimen_ok".  If the user
  71.   ;   terminates the dialog with CANCEL, no action will be taken.
  72.   ;   "accept" is the key name of the OK button (tile).
  73.  
  74.   (action_tile "accept" "(dimen_ok)")
  75.  
  76.  
  77.   (start_dialog)                ;returns after OK or CANCEL selected
  78.   (unload_dialog di_dcl_id)     ;free DCL from memory
  79. )
  80.  
  81. ;If the user selects OK, this function will be called to update
  82. ;  data, etc.
  83.  
  84. (defun dimen_ok ()
  85.   ; Get values from dialog, update AutoCAD
  86.   (mapcar 'get_tile_int chklist)
  87.   (mapcar 'get_tile_real realist)
  88.  
  89.   ;return 1 to start_dialog (Ok).  "dim_pos" contains the position
  90.   ;  of the dialog.  Next call will use that position.
  91.   (setq dim_pos (done_dialog 1)) 
  92. )
  93.  
  94.  
  95. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  96. ;
  97. ; SETCOLOR -- Test Various PDB Functions
  98. ;
  99. ;            This is a COLOR dialog that sets AutoCAD's current 
  100. ;            color using (command "color" color_num).  The color
  101. ;            names are displayed in a list box, color codes in an 
  102. ;            edit box, and actual color in an image tile.
  103. ;
  104. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  105.  
  106. (defun c:setcolor ( / ok coloridx clist colorstr)
  107.   ;load DCL file
  108.   (setq sc_dcl_id (load_dialog "dlgtest.dcl"))
  109.   (if (< sc_dcl_id 0) (exit))
  110.  
  111.   ; get current color
  112.   (setq colorstr (getvar "cecolor"))
  113.   (setq coloridx (atoi colorstr))
  114.  
  115.   ; load a dialog from dialog file
  116.   (if (not (new_dialog "setcolor" sc_dcl_id)) (exit))
  117.                                         ; load a dialog from dialog file
  118.  
  119.   ; Set up dialog list box
  120.  
  121.   (setq clist '("255"))
  122.   (setq idx 254)
  123.   (while (> idx 7) 
  124.     (setq clist (cons (itoa idx) clist))
  125.     (setq idx (1- idx))
  126.   )
  127.   (setq clist (cons "White" clist))
  128.   (setq clist (cons "Magenta" clist))
  129.   (setq clist (cons "Blue" clist))
  130.   (setq clist (cons "Cyan" clist))
  131.   (setq clist (cons "Green" clist))
  132.   (setq clist (cons "Yellow" clist))
  133.   (setq clist (cons "Red" clist))
  134.   (setq clist (cons "By layer" clist))
  135.  
  136.   (start_list "list_col")
  137.   (mapcar 'add_list clist)
  138.   (end_list)
  139.  
  140.   ; show initial color in image tile, list box, and edit box
  141.   (clist_act colorstr)
  142.   (cedit_act colorstr)
  143.  
  144.   ; Define the action to take when the user presses various buttons.
  145.   ;   $value will be substituted with the current value from the
  146.   ;   dialog widget, such as "4" from the 5th list box item
  147.   ;   (zero based).
  148.   ;
  149.   (action_tile "list_col" "(clist_act $value)")
  150.   (action_tile "edit_col" "(cedit_act $value)")
  151.   (if (= 1 (start_dialog))
  152.     ; User pressed OK
  153.     (if (/= coloridx 0)(command "_color" coloridx)(command "_color" "_bylayer")))
  154.   (unload_dialog sc_dcl_id)     ;free DCL from memory
  155. )
  156.  
  157. ; List selections end up here
  158. (defun clist_act (value)
  159.   ; update the edit box
  160.   (set_tile "edit_col" value)
  161.   (setq coloridx (atoi value))
  162.   (color_tile "show_image" coloridx)
  163. )
  164.  
  165. ; Text entry selections end up here
  166. (defun cedit_act (value)
  167.   ; update the list box
  168.   (set_tile "list_col" value)
  169.   (setq coloridx (atoi value))
  170.   (color_tile "show_image" coloridx)
  171. )
  172.  
  173.  
  174.  
  175. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  176. ;
  177. ;            General Purpose LISP PDB Functions
  178. ;
  179. ;
  180. ;   The get_ and set_ functions below assume that the tile key 
  181. ;   (button or edit box name) is the same as the AutoCAD 
  182. ;   variable name.
  183. ;
  184. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  185.  
  186. ; Get integer variable from AutoCAD and display in dialog
  187.  
  188. (defun set_tile_int (varname)
  189.   (setq vint (getvar varname))
  190.   (set_tile varname (itoa vint))
  191. )
  192.  
  193.  
  194. ; Get floating point variable from AutoCAD and display in dialog
  195.  
  196. (defun set_tile_real (varname)
  197.   (setq vreal (getvar varname))
  198.   (set_tile varname (rtos vreal))
  199. )
  200.  
  201.  
  202. ; Get integer variable from dialog and set in AutoCAD
  203.  
  204. (defun get_tile_int (varname)
  205.    (setvar varname (atoi (get_tile varname)))
  206. )
  207.  
  208. ; Get floating point variable from dialog and set in AutoCAD
  209.  
  210. (defun get_tile_real (varname)
  211.    (setvar varname (distof (get_tile varname)))
  212. )
  213.  
  214.  
  215.  
  216. ; Color a tile and show a border around it
  217.  
  218. (defun color_tile (tile color)
  219.   (setq x (dimx_tile tile))
  220.   (setq y (dimy_tile tile))
  221.   (start_image tile)
  222.   (fill_image 0 0 x y color)
  223.   (tile_rect 0 0 x y 7)
  224.   (end_image)
  225. )
  226.  
  227. ; Draw a rectangle in a tile (assumes start_image has been called)
  228.  
  229. (defun tile_rect (x1 y1 x2 y2 color)
  230.   (setq x2 (- x2 1))
  231.   (setq y2 (- y2 1))
  232.   (vector_image x1 y1 x2 y1 color)
  233.   (vector_image x2 y1 x2 y2 color)
  234.   (vector_image x2 y2 x1 y2 color)
  235.   (vector_image x1 y2 x1 y1 color)
  236. )
  237.