home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p086 / 3.img / ACADSUP.LIF / AFBUTTON.LSP < prev    next >
Encoding:
Lisp/Scheme  |  1991-04-08  |  1.6 KB  |  56 lines
  1. ;
  2. ;       Generate interactive buttons
  3. ;
  4. ;       Last updated in release 0.1l
  5. ;
  6. ;       Designed and implemented by Kelvin R. Throop in May of 1987.
  7. ;
  8.  
  9. (setq flixver "0.1l")
  10.  
  11. ;       BUTTON  --  Add a button to the image
  12.  
  13. (defun C:button ()
  14.         (initget 1)
  15.         (setq p1 (getpoint "\nFirst corner of button: "))
  16.         (initget 1)
  17.         (setq p2 (getcorner p1 "\nSecond corner of button: "))
  18.         (initget (+ 1 2 4))
  19.         (setq bn (getint "\nButton number: "))
  20.  
  21.         (setq c1 (list (min (car p1) (car p2)) (min (cadr p1) (cadr p2))))
  22.         (setq c2 (list (max (car p1) (car p2)) (max (cadr p1) (cadr p2))))
  23.  
  24.         (setvar "CMDECHO" 0)
  25.         (setq blippo (getvar "BLIPMODE"))
  26.         (setvar "BLIPMODE" 0)
  27.  
  28.         (setq slayer (getvar "CLAYER"))
  29.         (command "LAYER" "MAKE" "$$BUTTONS" "")
  30.         (setq scolour (getvar "CECOLOR"))
  31.         (command "COLOUR" 100)
  32.         ; Draw button outline polyline
  33.         (command "PLINE" c1 (list (car c1) (cadr c2))
  34.                          c2 (list (car c2) (cadr c1))
  35.                          "c"
  36.         )
  37.         ; Label button number
  38.         (command "TEXT" "MIDDLE" (list (/ (+ (car c1) (car c2)) 2.0)
  39.            (/ (+ (cadr c1) (cadr c2)) 2.0))
  40.            (* 0.9 (- (cadr c2) (cadr c1)))
  41.            0
  42.            (itoa bn)
  43.         )
  44.         ; Draw button definition line
  45.         (command "COLOUR" (+ 100 bn))
  46.         (command "LINE" c1 c2)
  47.         (command)
  48.  
  49.  
  50.         (command "LAYER" "SET" slayer "")
  51.         (command "COLOUR" scolour)
  52.         (setvar "BLIPMODE" blippo)
  53.         (setvar "CMDECHO" 1)
  54.         (princ)
  55. )
  56.