home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p190 / 3.ddi / LSP / LKEY.LSP < prev    next >
Encoding:
Text File  |  1980-03-18  |  1.8 KB  |  51 lines
  1. (defun C:LKEY ()
  2.  (setq fpt (getpoint "Enter base point:"))
  3.  (setq yn (getstring "left of base point? (Y/N):"))
  4.  (setq r (getdist fpt "Enter radius:"))
  5.  (setq l (getdist fpt "Enter length:"))
  6.  (if (or (= yn "Y") (= yn "y"))(progn
  7.             (setq c1 (polar fpt 0 r))
  8.             (setq c2 (polar fpt 0 (- l r)))            
  9.             (setq pa (polar fpt pi 4))
  10.  ))
  11.  (if (or (= yn "N") (= yn "n"))(progn
  12.             (setq c1 (polar fpt pi (- l r)))
  13.             (setq c2 (polar fpt pi r))
  14.             (setq pa (polar fpt pi (+ l 4)))
  15.  ))
  16.  (setq pt1 (polar c1 (/ pi 2.0) r))
  17.  (setq pt2 (polar c2 (/ pi 2.0) r))
  18.  (setq pt3 (polar c2 (- (/ pi 2.0) pi) r))
  19.  (setq pt4 (polar pt3 pi (- l r r)))
  20.  (setq pt5 (polar c2 (/ pi 4.0) r))
  21.  (setq pb (polar c2 0 (+ r 4)))
  22.  (setq pc (polar pt1 (/ pi 2.0) 4))
  23.  (setq pd (polar pt4 (* 3 (/ pi 2.0)) 4))
  24.  (setq pe (polar pt2 (/ pi 2.0) 4))
  25.  (setq pf (polar pt3 (* 3 (/ pi 2.0)) 4))
  26.  (setq l1 (rtos l 2 1))
  27.  (setq r1 (rtos (* r 2) 2 1))
  28.  (setq xc (car fpt) yc (cadr fpt))
  29.  (command "layer" "s" "1" "")
  30.  (command "line" pa pb "")
  31.  (command "line" pc pd "")
  32.  (command "line" pe pf "")
  33.  (command "layer" "s" "0" "")
  34.  (command "pline" pt4 "w" "0.35" "" pt3 "a" "ce" c2 pt2 "l" pt1 "a" "ce" c1 pt4 "")
  35.  (if (or (= yn "Y") (= yn "y"))(progn
  36.  (command "dim" "hor" fpt (polar fpt 0 l) (polar pt4 (- (/ pi 2)) 10) l1 "exit")
  37.  (command "dim" "ver" pt1 pt4 (polar fpt pi 10) r1 "exit")
  38.  (command "line" (list (- xc 10) (+ yc r)) (list (- xc 10) (- yc r)) "")
  39.  ))
  40.  (if (or (= yn "N") (= yn "n"))(progn
  41.  (command "dim" "hor" fpt (polar fpt pi l) (polar pt4 (- (/ pi 2)) 10) l1 "exit")
  42.  (command "dim" "ver" pt1 pt4 (polar fpt pi (+ l 10)) r1 "exit")
  43.  (command "line" (list (- xc l 10) (+ yc r)) (list (- xc l 10) (- yc r)) "")
  44.  ))
  45.  (command "dim" "rad" pt5 "R" 10 "exit")
  46. (redraw)
  47.  (clean)
  48. (quit)
  49. )
  50.  
  51.