home *** CD-ROM | disk | FTP | other *** search
/ Share Gallery 1 / share_gal_1.zip / share_gal_1 / GR / GR505.ZIP / LSP.EXE / GEAR.LSP < prev    next >
Lisp/Scheme  |  1987-07-12  |  2KB  |  69 lines
  1. (defun grinfo ()
  2.    (setq c (getpoint "\nCenter of Gear: ")) 
  3.    (setq pc (getpoint "\nPitch Circle: "))
  4.    (setq teeth (getint "\nNumber of teeth: ")) 
  5.    (while (< teeth 14) (setq teeth (getint "\nMust be at least 14 teeth: "))) 
  6.    (while (> teeth 50) (setq teeth (getint "\nMust be no more than 50 teeth: "))) 
  7.    (while (< teeth 14) (setq teeth (getint "\nMust be at least 14 teeth: "))) 
  8.    (while (> teeth 50) (setq teeth (getint "\nMust be no more than 50 teeth: "))) 
  9. )
  10. (defun calgear ()
  11.    (setq d (* 2 (distance c pc))) (setq pc (polar c 0 (/ d 2)))
  12.    (setq ang3 2.79248)
  13.    (setq ang5 (/ 360.000000 teeth))
  14.    (setq wang -0.785385)
  15.    (setq wang2 0.785385)
  16.    (setq dp (/ teeth d))
  17.    (setq ht (/ 0.32 dp))
  18.    (setq adm (/ 1.0 dp))
  19.    (setq y (* (/ 2.257 dp) 1.0642))
  20. )
  21. (defun drawgear ()
  22.    (command "PLINE"
  23.       (setq p (polar pc 0 adm))
  24.       "a" 
  25.       "ce" 
  26.       c 
  27.       "l" 
  28.       ht 
  29.       "l" 
  30.       (setq p (polar (getvar "lastpoint") ang3 y)) 
  31.       "a" 
  32.       "ce" 
  33.       c 
  34.       "l" 
  35.       ht 
  36.       ""
  37.    )
  38.    (SETQ TOP (GETVAR "LASTPOINT")) 
  39.    (command "MIRROR" 
  40.       "L" 
  41.       ""
  42.       (setq p (polar pc 0 adm)) 
  43.       c 
  44.       "n" 
  45.    )
  46.    (command "ARRAY"
  47.        "w"
  48.        (POLAR TOP 4.712389 (* Y 1.5))
  49.        (polar TOP 0 Y)
  50.        ""
  51.        "c"
  52.        c
  53.        ang5
  54.        "-360"
  55.        "Y"
  56.    )
  57. )
  58. (defun C:GEAR ()
  59.     (grinfo)
  60.     (setq stdots (getvar "blipmode"))
  61.     (setq stech (getvar "cmdecho"))
  62.     (setvar "blipmode" 0)
  63.     (setvar "cmdecho" 0)
  64.     (calgear)
  65.     (drawgear)
  66.     (setvar "blipmode" stdots)
  67.     (setvar "cmdecho" stech)
  68. )
  69. xt-flag "se