home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 15 / CD_ASCQ_15_070894.iso / vrac / mar94cad.zip / TIP963.LSP < prev    next >
Lisp/Scheme  |  1994-02-15  |  1KB  |  51 lines
  1. ; TIP963.LSP: ISOA.LSP   Divide Isometric Ellipse   (c)1994, R. McDowell
  2.  
  3. (defun  C:ISOA  (/ a1 a2 a3 b1 r1 p1 p2 p3 l1 l2 index x y )
  4.    (setq a1 (getint "Enter Number of Spaces: "))
  5.    (setq l1 (getint "Enter Plane: 1=TOP 2=RIGHT 3=LEFT "))
  6.    (if (= l1 1) (setq l2 (* (* 2.0 pi )  0.0 )))
  7.    (if (= l1 2) (setq l2 (/ (* 2.0 pi )  6.0 )))
  8.    (if (= l1 3) (setq l2 (/ (* 2.0 pi ) -6.0 )))
  9.    (setq r1 (getreal "Enter Radius: "))
  10.    (setq r1 (* r1 1.224733))
  11.    (setq p1 (getpoint "Enter Center of ISO Array"))
  12.    (setq a2 (/ (* 2.0 pi) a1))
  13.    (setq b1 (* (sin (atan (/ 1.0 (sqrt 2.0)))) r1 ))
  14.    (setq index 0)
  15.    (repeat a1
  16.       (setq x (* r1
  17.             (cos
  18.                (+ (/ (* 2.0 pi ) 8.0 )
  19.                   (setq a3 (* a2 index))
  20.                )
  21.             )
  22.       ))
  23.       (setq y
  24.          (sqrt
  25.             (- (expt b1 2.0)
  26.                (/ 
  27.                   (* (expt x 2.0) (expt b1 2.0))
  28.                   (expt r1 2.0)
  29.                )
  30.             )
  31.          )
  32.       )
  33.       (setq index (1+ index))
  34.       (if (> a3 (* 0.75 pi )) (setq y (* y -1)))
  35.       (if (> a3 (* 1.75 pi )) (setq y (* y -1)))
  36.       (setq p2
  37.          (list 
  38.             (- (* x (cos l2)) (* y (sin l2)))
  39.             (+ (* x (sin l2)) (* y (cos l2)))
  40.          )
  41.       )
  42.       (setq p3
  43.          (list
  44.             (+ (car  p1) (car  p2))
  45.             (+ (cadr p1) (cadr p2))
  46.          )
  47.       )
  48.       (command "point" p3)
  49.    )
  50. ); end isoa.lsp
  51.