home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p024 / 11.img / BONUS2.LIB / DLGTEST.LSP < prev    next >
Encoding:
Text File  |  1993-02-09  |  7.1 KB  |  237 lines
  1. ;;;------------------------------------------------------------------------
  2. ;;;   DLGTEST.LSP
  3. ;;;   ¬⌐┼v (C) 1990-92  Autodesk ñ╜Ñq
  4. ;;;
  5. ;;;   »Sª╣┴n⌐·Ñ╗│n┼Θ╗PñσÑ≤ºK╢O¿╤▒z╢iªµÑ⌠ª≤Ñ╬│~╗▌¿D¬║½■¿⌐íB¡╫º∩ñ╬╡oªµíC
  6. ;;;
  7. ;;;
  8. ;;;   Ñ╗│n┼Θ╢╚┤ú¿╤º@¼░└│Ñ╬ñW¬║░╤ª╥, ª╙Ñ╝┴n⌐·⌐╬┴⌠ºtÑ⌠ª≤½O├╥; ╣∩⌐≤Ñ⌠ª≤»S«φ
  9. ;;;   Ñ╬│~ñº╛A║┘⌐╩, ÑHñ╬░╙╖~╛P░Γ⌐╥┴⌠ºtÑX¿π¬║½O├╥, ªbª╣ñ@╖ºñ⌐ÑHº_╗{íC
  10. ;;;
  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 "Ñ╒ªΓ" clist))
  128.   (setq clist (cons "╡╡¼⌡" clist))
  129.   (setq clist (cons "┬┼" clist))
  130.   (setq clist (cons "ñ⌠┬┼" clist))
  131.   (setq clist (cons "║±" clist))
  132.   (setq clist (cons "╢└" clist))
  133.   (setq clist (cons "¼⌡" clist))
  134.   (setq clist (cons "¿╠╖╙╣╧╝h" 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.