AutoLISP Gear Generator

This script adds 2 commands to AutoCAD: extgear (external gear) and intgear (internal gear). The gear will be drawn around the origin point, so keep the drawing area clear!
Used with AutoCAD 2016.


;GEAR.LSP - This program generates involute curve profile.

(defun c:extgear ()
  (setq numt (getint "Number of Teeth:<24> "))
  (if (= numt nil)
    (setq numt 24))
  (setq cirp (getreal "Circular Pitch:<3.00> "))
  (if (= cirp nil)
    (setq cirp 3.000))
  (setq prsa (getreal "Pressure Angle:<20.0> "))
  (if (= prsa nil)
    (setq prsa 20.0))
  (setq clrc (getreal "Clearance:<0.1> "))
  (if (= clrc nil)
    (setq clrc 0.1))

  (setq diap (/ pi cirp))
  (setq adum (/ 1.0 diap))
  (setq ddum (+ adum clrc))
  (setq tt (- (/ cirp 2.0) clrc))

  (setvar "orthomode" 0)
  (setvar "coords" 1)
  (setvar "osmode" 0)
;START CALCULATIONS
;
  (setq pnts 19) ;determines involute curve accuracy
  (setq prsa (/ (* prsa pi) 180.0)) ;pressure angle to radians
  (setq pitr (/ numt (* diap 2.0))) ;calc pitch radius
  (setq irad (- pitr ddum))         ;calc inside radius
  (setq orad (+ pitr adum))         ;calc outer radius
  (setq basr (* pitr (cos prsa)))   ;calc base radius of gear
  (setq z (- (expt orad 2.0) (expt basr 2.0)))  ;three lines of
  (setq x (sqrt z))                             ;code to make
  (setq paodd (atan (/ x basr)))                ;an arccosine

  (if (> basr irad)
    (PROGN
      (setq p 0.0)
      (setq ps (polar p2 (/ pi 2.0) basr))
    )
    ;else
    (PROGN
      (setq z (- (expt irad 2.0) (expt basr 2.0)))  ;three lines of
      (setq x (sqrt z))                             ;code to make
      (setq p (atan (/ x basr)))                    ;an arccosine
      (setq e1 (sin p))
      (setq e2 (cos p))
      (setq e (/ e1 e2))
      (setq j (- e p))
      (setq x1 (* (/ (sin j) (cos p)) basr))
      (setq y1 (* (/ (cos j) (cos p)) basr))
      (setq ps (list x1 y1))
    )
  )

  (setq incr (/ (- paodd p) pnts))
  (setq tta (* diap (/ tt numt)))
  (GRAPHSCR)
  (setq p2 '(0 0))     ;Center of Gear
  (setq x2 (CADR p2))
  (setq y2 (CAR p2))
  (setq y5 (+ y2 basr))
  (setq y6 (+ y2 irad))
  (setq p6 (list x2 y6))
  (setq p5 (list x2 y5))
  ;(setq pz1 (polar p2 1.95 (* basr 0.9)))
  ;(setq pz2 (polar p2 1.35 (* orad 1.5)))
  (setq pz1 (polar p2 (* 1.25 pi) (* orad 1.5)))
  (setq pz2 (polar p2 (* 0.25 pi) (* orad 1.5)))
  (COMMAND "CIRCLE" P2 pitr) ;place pitch circle
  ;(COMMAND "CIRCLE" P2 basr) ;place base circle
  ;(COMMAND "CIRCLE" P2 irad) ;place inside circle
  (COMMAND "ZOOM" "w" pz1 pz2) ;Window for drawing curve
  (setq s (ssadd))
  (setq le (entlast))
;
;begin a loop for placement of coordinate pairs
;the command pline will be used to generate a polyline whose
;vertices will be computed by a standard involute curve formula
;drawn from base diameter to the od of the part
;
;In polar coordinates, the involute curve is defined by
;                       r = basr / cos(p)
;                       theta = tan(p) - p
;
;converting this to cartesian (flipping x and y) gives
;x = r*sin(theta) = (basr / cos(p)) * sin(tan(p)-p)
;y = r*cos(theta) = (basr / cos(p)) * cos(tan(p)-p)
;
  (setq test 0)
  (if (> basr irad)
    (PROGN
      (COMMAND "LINE" p6)
      (COMMAND p5)
      (COMMAND "")
    )
  )
  ;(initget "Y y N n")
  (COMMAND "PLINE" ps)
  (setq p (+ incr p))
  (while (> pnts 0)
    (setq e1 (sin p))
    (setq e2 (cos p))
    (setq e (/ e1 e2))
    (setq j (- e p))
    (setq x1 (* (/ (sin j) (cos p)) basr))
    (setq y1 (* (/ (cos j) (cos p)) basr))
    (setq x3 (+ x2 x1))
    (setq y3 (+ y2 y1))
    (setq p3 (list x3 y3))
    (COMMAND p3)
    (setq p (+ incr p))
    (setq pnts (- pnts 1))
    (if (/= test 1)
      (PROGN
        (setq hyp (sqrt (+ (expt x1 2) (expt y1 2))))
        (if (> hyp irad)
          (progn
            (setq pint p3)
            (setq test 1))
        )
      )
    )
  )
  (COMMAND "")
  (initget "Y y N n")
  (setq ans Y)
  (if (/= ans "N")
    (PROGN
      (setq pz3 (polar p2 (* pi 1.25) (* orad 1.6)))
      (setq pz4 (polar p2 (* pi 0.25) (* orad 1.6)))
      (setq ang13 (/ (sin prsa) (cos prsa)))
      (setq ang11 (- ang13 prsa))
      (setq x11 (* (sin ang11) pitr))
      (setq y11 (* (cos ang11) pitr))
      (setq p11 (list x11 y11))
      (setq ang (angle p2 p11))
      (setq angi (- ang tta))
      (setq p12 (polar p2 angi (/ ORAD 0.8)))
      (setq beta (angle p2 p3))
      (setq ang2 (- (* angi 2.0) beta))
      (setq p15 (polar p2 ang2 orad))
      (setq adj1 (- ang2 j))
      (setq adj2 (+ adj1 (/ (* pi 2.0) numt)))
      (setq adj3 (+ adj2 0.3))
      (setq p22 (polar p2 adj3 irad))
      (setq p17 (polar p2 adj2 irad))
      (setq p18 (polar p2 adj2 basr))
      (setq angr (* (+ ang11 tta) (/ 180.0 pi)))
      (setq p21 (polar p2 ang2 (/ orad 0.8)))
      (setq angm (+ angi (/ pi numt)))
      (setq p19 (polar p2 angm irad))
      (setq angj (* (+ ang11 tta) 2.0))
      (setq angk (/ (- (/ (* 2.0 pi) numt) angj) 2.0))
      (setq angl (+ (/ pi 2.0) angk))

      (if (< basr irad)
        (PROGN
          (setq psang (- (/ pi 2.0) (angle p2 ps)))
          (setq p23 (polar p2 (+ adj2 psang) irad))
          (setq p24 ps)
        )
        ;else
        (PROGN
          (setq p23 (polar p2 adj2 irad))
          (setq p24 p6)
        )
      )
      (COMMAND "MIRROR" "W" p22 p21 "" p2 p12 "")
      (COMMAND "ARC" p15 "c" p2 p3)
      (COMMAND "ARC" p24 "c" p2 p23)
      (COMMAND "ROTATE" "w" pz3 pz4 "" p2 angr)
      (while (setq le (entnext le))
        (ssadd le s)
      )
      (COMMAND "ARRAY" s "" "p" p2 numt "" "")
    )
  )
  (Prompt "\nDone!  ")
  (princ)
)








(defun c:intgear ()
  (setq numt (getint "Number of Teeth:<24> "))
  (if (= numt nil)
    (setq numt 24))
  (setq cirp (getreal "Circular Pitch:<3.00> "))
  (if (= cirp nil)
    (setq cirp 3.000))
  (setq prsa (getreal "Pressure Angle:<20.0> "))
  (if (= prsa nil)
    (setq prsa 20.0))
  (setq clrc (getreal "Clearance:<0.1> "))
  (if (= clrc nil)
    (setq clrc 0.1))

  (setq diap (/ pi cirp))
  (setq ddum (/ 1.0 diap))
  (setq adum (+ ddum clrc))
  (setq tt (+ (/ cirp 2.0) clrc))

  (setvar "orthomode" 0)
  (setvar "coords" 1)
  (setvar "osmode" 0)
;START CALCULATIONS
;
  (setq pnts 19) ;determines involute curve accuracy
  (setq prsa (/ (* prsa pi) 180.0)) ;pressure angle to radians
  (setq pitr (/ numt (* diap 2.0))) ;calc pitch radius
  (setq irad (- pitr ddum))         ;calc inside radius
  (setq orad (+ pitr adum))         ;calc outer radius
  (setq basr (* pitr (cos prsa)))   ;calc base radius of gear
  (setq z (- (expt orad 2.0) (expt basr 2.0)))  ;three lines of
  (setq x (sqrt z))                             ;code to make
  (setq paodd (atan (/ x basr)))                ;an arccosine
  (if (> basr irad)
    (PROGN
      (setq p 0.0)
      (setq ps (polar p2 (/ pi 2.0) basr))
    )
    ;else
    (PROGN
      (setq z (- (expt irad 2.0) (expt basr 2.0)))  ;three lines of
      (setq x (sqrt z))                             ;code to make
      (setq p (atan (/ x basr)))                    ;an arccosine
      (setq e1 (sin p))
      (setq e2 (cos p))
      (setq e (/ e1 e2))
      (setq j (- e p))
      (setq x1 (* (/ (sin j) (cos p)) basr))
      (setq y1 (* (/ (cos j) (cos p)) basr))
      (setq ps (list x1 y1))
    )
  )
  (setq incr (/ (- paodd p) pnts))
  (setq tta (* diap (/ tt numt)))
  (GRAPHSCR)
  (setq p2 '(0 0))     ;Center of Gear
  (setq x2 (CADR p2))
  (setq y2 (CAR p2))
  (setq y5 (+ y2 basr))
  (setq y6 (+ y2 irad))
  (setq p6 (list x2 y6))
  (setq p5 (list x2 y5))
  ;(setq pz1 (polar p2 1.95 (* basr 0.9)))
  ;(setq pz2 (polar p2 1.35 (* orad 1.5)))
  (setq pz1 (polar p2 (* 1.25 pi) (* orad 1.5)))
  (setq pz2 (polar p2 (* 0.25 pi) (* orad 1.5)))
  (COMMAND "CIRCLE" P2 pitr) ;place pitch circle
  ;(COMMAND "CIRCLE" P2 basr) ;place base circle
  ;(COMMAND "CIRCLE" P2 irad) ;place inside circle
  (COMMAND "ZOOM" "w" pz1 pz2) ;Window for drawing curve
  (setq s (ssadd))
  (setq le (entlast))
;
;begin a loop for placement of coordinate pairs
;the command pline will be used to generate a polyline whose
;vertices will be computed by a standard involute curve formula
;drawn from base diameter to the od of the part
;
;In polar coordinates, the involute curve is defined by
;                       r = basr / cos(p)
;                       theta = tan(p) - p
;
;converting this to cartesian (flipping x and y) gives
;x = r*sin(theta) = (basr / cos(p)) * sin(tan(p)-p)
;y = r*cos(theta) = (basr / cos(p)) * cos(tan(p)-p)
;
  (setq test 0)
  ;(COMMAND "LINE" p6)
  ;(COMMAND p5)
  ;(COMMAND "")
  ;(initget "Y y N n")
  (COMMAND "PLINE" ps)
  (setq p (+ incr p))
  (while (> pnts 0)
    (setq e1 (sin p))
    (setq e2 (cos p))
    (setq e (/ e1 e2))
    (setq j (- e p))
    (setq x1 (* (/ (sin j) (cos p)) basr))
    (setq y1 (* (/ (cos j) (cos p)) basr))
    (setq x3 (+ x2 x1))
    (setq y3 (+ y2 y1))
    (setq p3 (list x3 y3))
    (COMMAND p3)
    (setq p (+ incr p))
    (setq pnts (- pnts 1))
    (if (/= test 1)
      (PROGN
        (setq hyp (sqrt (+ (expt x1 2) (expt y1 2))))
        (if (> hyp irad)
          (progn
            (setq pint p3)
            (setq test 1))
        )
      )
    )
  )
  (COMMAND "")
  (initget "Y y N n")
  (setq ans Y)
  (if (/= ans "N")
    (PROGN
      (setq pz3 (polar p2 (* pi 1.25) (* orad 1.6)))
      (setq pz4 (polar p2 (* pi 0.25) (* orad 1.6)))
      (setq ang13 (/ (sin prsa) (cos prsa)))
      (setq ang11 (- ang13 prsa))
      (setq x11 (* (sin ang11) pitr))
      (setq y11 (* (cos ang11) pitr))
      (setq p11 (list x11 y11))
      (setq ang (angle p2 p11))
      (setq angi (- ang tta))
      (setq p12 (polar p2 angi (/ ORAD 0.8)))
      (setq beta (angle p2 p3))
      (setq ang2 (- (* angi 2.0) beta))
      (setq p15 (polar p2 ang2 orad))
      (setq adj1 (- ang2 j))
      (setq adj2 (+ adj1 (/ (* pi 2.0) numt)))
      (setq adj3 (+ adj2 0.3))
      (setq p22 (polar p2 adj3 basr))
      (setq p17 (polar p2 adj2 irad))
      (setq p18 (polar p2 adj2 basr))
      (setq angr (* (+ ang11 tta) (/ 180.0 pi)))
      (setq p21 (polar p2 ang2 (/ orad 0.8)))
      (setq angm (+ angi (/ pi numt)))
      (setq p19 (polar p2 angm irad))

      (if (< basr irad)
        (PROGN
          (setq psang (- (/ pi 2.0) (angle p2 ps)))
          (setq p23 (polar p2 (+ adj2 psang) irad))
        )
        ;else
        (setq p23 (polar p2 adj2 basr))
      )
      (COMMAND "MIRROR" "W" p22 p21 "" p2 p12 "")
      (COMMAND "ARC" p15 "c" p2 p3)
      (COMMAND "ARC" ps "c" p2 p23)
      (COMMAND "ROTATE" "w" pz3 pz4 "" p2 angr)
      (while (setq le (entnext le))
        (ssadd le s)
      )
      (COMMAND "ARRAY" s "" "p" p2 numt "" "")
    )
  )
  (Prompt "\nDone!  ")
  (princ)
)