;;; --------------------------------------------------------------------------- ;;; SpurGear.lsp ;;; code compiled by YZ August 2026 ;;; --------------------------------------------------------------------------- ;;; INVOLUTE SPUR GEAR GENERATOR ;;; ;;; PURPOSE ;;; Draws a spur gear to standard proportions from the numbers an engineer ;;; actually has: the tooth count, the module or diametral pitch, and the ;;; pressure angle. The tooth flanks are true involutes computed from the ;;; geometry, not arcs fitted by eye, so the drawing can be trusted for ;;; manufacture, for checking a mating pair, or for cutting on a machine. ;;; ;;; WHY THE ORIGINAL WAS REPLACED RATHER THAN REPAIRED ;;; The routine this grew out of could not run. Its first drawing instruction ;;; was (command "LIMITS" (list X Y) (list XX YY)) and none of X, Y, XX or YY ;;; was ever given a value, so it failed on the first line every time. ;;; ;;; Even with that fixed, its method could not be salvaged. It built the tooth ;;; by drawing a construction circle of radius DP/8 - a number with no basis in ;;; gear geometry - then BREAKing it at points found with OSNAP picks on screen ;;; coordinates, MIRRORing the result with a window selection, and ARRAYing it ;;; round. Anything not selected exactly by those windows was left behind or ;;; erased by mistake. The formulae had errors too: the addendum circle was ;;; given as DP + 1/P where it should be DP + 2/P, the dedendum circle was ;;; given the outside diameter formula, and the fillet was divided by the pitch ;;; diameter where it should have been divided by the diametral pitch. ;;; ;;; What follows computes the profile instead. ;;; ;;; THE GEOMETRY ;;; An involute is the curve traced by the end of a string unwound from a ;;; circle - the base circle. It is the only tooth shape that transmits motion ;;; at a constant ratio regardless of small errors in the centre distance, ;;; which is why every standard gear uses one. ;;; ;;; The useful form here is polar. At any radius r on the flank, the half ;;; thickness of the tooth in angle is ;;; ;;; psi(r) = pi/(2N) + inv(phi) - inv(alpha) ;;; ;;; where inv(a) = tan(a) - a is the involute function, phi is the pressure ;;; angle, and alpha = acos(rb/r) is the pressure angle at that radius. At the ;;; pitch circle alpha equals phi and psi comes out at pi/2N, which is half the ;;; circular pitch - exactly as it should be. Higher up the tooth alpha grows, ;;; inv(alpha) grows, and psi shrinks, which is why teeth taper to the tip. ;;; ;;; No involute exists inside the base circle, because the string has not begun ;;; to unwind. Where the root falls below it - which happens on any gear with ;;; fewer than about forty teeth - the flank is continued as a radial line and ;;; blended into the root circle with a proper tangent fillet. ;;; ;;; If the tooth would come to a point below the nominal tip - which happens ;;; when the count is very low - the outside diameter is cut back to where the ;;; flanks actually meet, and you are told by how much. ;;; ;;; STANDARD PROPORTIONS ;;; addendum = 1.00 m outside dia = D + 2m ;;; dedendum = 1.25 m root dia = D - 2.5m ;;; pitch dia = N m base dia = D cos(phi) ;;; ;;; where m is the module. In imperial the module is 1/P, P being the diametral ;;; pitch, and the same formulae hold throughout. ;;; ;;; SPURGEAR - draw an involute spur gear ;;; --------------------------------------------------------------------------- ;;; --------------------------------------------------------------------------- ;;; MATHS ;;; --------------------------------------------------------------------------- ;;; Arc cosine. AutoLISP has no such function, but the two-argument ATAN is ;;; quadrant-aware, so feeding it the opposite and adjacent sides gives the ;;; angle directly, over the full 0 to pi range acos needs. (defun SpurGear:Acos ( x ) (cond ((>= x 1.0) 0.0) ((<= x -1.0) pi) (t (atan (sqrt (- 1.0 (* x x))) x))) ) ;;; The involute function, inv(a) = tan(a) - a. (defun SpurGear:Inv ( a ) (- (/ (sin a) (cos a)) a)) ;;; Half the angular thickness of the tooth at radius r, measured from the ;;; tooth centreline. Below the base circle there is no involute, so the value ;;; is held at what it is on the base circle - which draws the flank as a ;;; radial line, the usual treatment. (defun SpurGear:Psi ( r rb n invphi ) (+ (/ pi (* 2.0 n)) invphi (- (SpurGear:Inv (SpurGear:Acos (/ rb (max r rb)))))) ) ;;; A point at radius r and angle a about the origin, offset to the gear centre. (defun SpurGear:Pt ( cen r a ) (list (+ (car cen) (* r (cos a))) (+ (cadr cen) (* r (sin a)))) ) ;;; The radius at which the two flanks meet - the point of a pointed tooth. ;;; Found by bisection between the pitch circle, where the tooth certainly has ;;; width, and a generous outer bound where it certainly does not. (defun SpurGear:PointedAt ( rp rb n invphi / lo hi mid i ) (setq lo rp hi (* 4.0 rp) i 0) (while (< i 60) (setq mid (/ (+ lo hi) 2.0)) (if (> (SpurGear:Psi mid rb n invphi) 0.0) (setq lo mid) (setq hi mid)) (setq i (1+ i))) lo ) ;;; --------------------------------------------------------------------------- ;;; THE PROFILE ;;; ;;; The whole gear is built as one closed polyline. Working right round the ;;; outline in one pass avoids the joins, gaps and stray fragments that come of ;;; drawing a tooth and arraying it. ;;; --------------------------------------------------------------------------- ;;; The fillet blending a radial flank into the root circle. Returns the sampled ;;; arc as a list of points, running from the root circle up to where it meets ;;; the flank. BETA is the angle of the radial flank, SIDE is +1 or -1 saying ;;; which way round the gap lies. ;;; ;;; The fillet centre sits at radius rr + rf from the gear centre, turned away ;;; from the flank by asin(rf / (rr + rf)) - the angle at which its perpendicular ;;; distance from the flank line is exactly rf, which is what tangency means. (defun SpurGear:Fillet ( cen rr rf beta side steps / d delta a0 fc rTan aTan i out u ) (if (<= rf 1e-9) nil (progn (setq d (+ rr rf) delta (SpurGear:Acos (/ (sqrt (max 0.0 (- (* d d) (* rf rf)))) d)) fc (SpurGear:Pt cen d (+ beta (* side delta))) ;; Where the fillet touches the root circle. aTan (+ beta (* side delta)) ;; Where it touches the flank: the foot of the perpendicular. rTan (sqrt (max 0.0 (- (* d d) (* rf rf)))) a0 (angle fc (SpurGear:Pt cen rr aTan)) i 0 out nil) ;; Sweep the fillet arc from the root tangency round to the flank ;; tangency, taking the short way. (setq u (- (angle fc (SpurGear:Pt cen rTan beta)) a0)) (while (> u pi) (setq u (- u (* 2.0 pi)))) (while (< u (- pi)) (setq u (+ u (* 2.0 pi)))) (while (<= i steps) (setq out (cons (polar fc (+ a0 (* u (/ (float i) steps))) rf) out) i (1+ i))) (reverse out) ) ) ) ;;; One flank, from the root end up to the tip, at angular offset SIDE * psi(r) ;;; about the tooth centreline TH. (defun SpurGear:Flank ( cen th side rStart rEnd rb n invphi steps / i r out f ) (setq i 0 out nil) (while (<= i steps) ;; Sampled on a squared parameter so the points bunch up near the root, ;; where the involute turns most sharply. (setq f (/ (float i) steps) r (+ rStart (* (- rEnd rStart) f f)) out (cons (SpurGear:Pt cen r (+ th (* side (SpurGear:Psi r rb n invphi)))) out) i (1+ i))) (reverse out) ) ;;; An arc of points at constant radius, from angle a1 to a2. (defun SpurGear:Sweep ( cen r a1 a2 steps / i out ) (setq i 0 out nil) (while (<= i steps) (setq out (cons (SpurGear:Pt cen r (+ a1 (* (- a2 a1) (/ (float i) steps)))) out) i (1+ i))) (reverse out) ) ;;; --------------------------------------------------------------------------- ;;; ENTITY MAKING ;;; --------------------------------------------------------------------------- (defun SpurGear:Layer ( name colour ) (if (not (tblsearch "LAYER" name)) (entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") (cons 2 name) '(70 . 0) (cons 62 colour) '(6 . "Continuous")))) name ) (defun SpurGear:Poly ( pts layer closed ) (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") (cons 8 layer) '(100 . "AcDbPolyline") (cons 90 (length pts)) (cons 70 (if closed 1 0))) (mapcar '(lambda ( p ) (cons 10 (list (car p) (cadr p)))) pts))) ) (defun SpurGear:Circle ( cen rad layer ) (entmake (list '(0 . "CIRCLE") (cons 8 layer) (cons 10 (list (car cen) (cadr cen) 0.0)) (cons 40 rad))) ) ;;; --------------------------------------------------------------------------- ;;; MAIN COMMAND ;;; --------------------------------------------------------------------------- (defun c:SPURGEAR ( / *error* vars vals cen n phi phiR module dp metric rp rb ro rr rf invphi rPoint clipped th step pts k rStartL rStartR aRoot lay con bore keyW keyD half yTop v i tip ) (setq vars '("CMDECHO" "BLIPMODE" "CLAYER" "OSMODE") vals (mapcar 'getvar vars)) (defun SpurGear:Restore ( ) (mapcar 'setvar vars vals) (while (= 8 (logand 8 (getvar 'undoctl))) (command "_.UNDO" "_End")) (vl-catch-all-apply '(lambda ( ) (*pop-error-mode*)) '()) (princ) ) (defun *error* ( msg ) (SpurGear:Restore) (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*"))) (princ (strcat "\n** SPURGEAR error: " msg " **"))) (princ) ) (setvar "CMDECHO" 0) (setvar "BLIPMODE" 0) (setvar "OSMODE" 0) ;; AutoCAD 2015 and later refuse (command) inside an *error* handler unless ;; the routine says up front that it will use one. (vl-catch-all-apply '(lambda ( ) (*push-error-using-command*)) '()) (command "_.UNDO" "_Begin") ;; --- the numbers -------------------------------------------------------- (initget 6) (setq n (getint "\nNumber of teeth <24>: ")) (if (null n) (setq n 24)) (if (< n 6) (progn (princ "\n Six is the fewest that will draw. Using six.") (setq n 6))) (initget "Module Pitch") (setq v (getkword "\nSize by [Module/diametral Pitch] : ")) (setq metric (/= "Pitch" v)) (if metric (progn (initget 6) (setq module (getreal "\nModule <2.0>: ")) (if (null module) (setq module 2.0)) (setq dp (/ 1.0 module))) (progn (initget 6) (setq dp (getreal "\nDiametral pitch <12.0>: ")) (if (null dp) (setq dp 12.0)) (setq module (/ 1.0 dp)))) (initget "14.5 20 25") (setq v (getkword "\nPressure angle [14.5/20/25] <20>: ")) (setq phi (cond ((= v "14.5") 14.5) ((= v "25") 25.0) (t 20.0))) ;; --- everything else follows from those three --------------------------- (setq phiR (/ (* pi phi) 180.0) invphi (SpurGear:Inv phiR) rp (/ (* n module) 2.0) ; pitch radius rb (* rp (cos phiR)) ; base radius ro (+ rp module) ; tip radius, addendum 1.00 m rr (- rp (* 1.25 module)) ; root radius, dedendum 1.25 m rf (* 0.38 module)) ; root fillet ;; A fillet cannot reach above the base circle without eating the involute, ;; and cannot be wider than the gap it sits in. (setq rf (min rf (max 0.0 (/ (- (* rb rb) (* rr rr)) (* 2.0 rr))))) (if (< rr 0.0) (progn (princ "\n** Too few teeth for that pitch - the root would pass" " through the centre. **") (setq n nil))) (if n (progn ;; Cut the tip back if the flanks would cross before reaching it. (setq rPoint (SpurGear:PointedAt rp rb n invphi) clipped nil) (if (> ro rPoint) (setq clipped (- ro rPoint) ro (* 0.999 rPoint))) (setq cen (getpoint "\nCentre of the gear: ")) (if (null cen) (princ "\nCancelled.") (progn (setq cen (list (car cen) (cadr cen) 0.0) lay (SpurGear:Layer "Gear" 7) con (SpurGear:Layer "Gear-Construction" 8) step (/ (* 2.0 pi) n) pts nil k 0) ;; Two numbers govern where the flank meets the root, and ;; they differ depending on whether a fillet is needed. ;; ;; rStartR the radius at which the drawn flank begins ;; aGap the half angle of the gap at the root circle, ;; measured from the tooth centreline ;; ;; With a fillet, the flank begins where the fillet leaves ;; off - at the foot of the perpendicular from the fillet ;; centre, which is sqrt(rr^2 + 2 rr rf) - and the gap is ;; widened by the fillet's own turn, delta. (if (< rr rb) (setq rStartR (sqrt (+ (* rr rr) (* 2.0 rr rf))) aGap (+ (SpurGear:Psi rb rb n invphi) (SpurGear:Acos (/ (sqrt (max 0.0 (- (* (+ rr rf) (+ rr rf)) (* rf rf)))) (+ rr rf))))) (setq rStartR rr aGap (SpurGear:Psi rr rb n invphi))) ;; If the gaps have closed up, the fillet is too big for the ;; space between teeth. Say so rather than draw a tangle. (if (>= (* 2.0 aGap) step) (progn (princ "\n** Root fillet too large for this tooth" " count - drawing without it. **") (setq rf 0.0 rStartR rr aGap (SpurGear:Psi (max rr rb) rb n invphi)))) ;; --- the outline -------------------------------------- ;; Round the gear once, anticlockwise: up the trailing flank ;; of each tooth, across the tip, down the leading flank, ;; then along the root to the next tooth. Every piece is ;; generated in the direction of travel, so the point list ;; joins up without any reordering. (while (< k n) (setq th (* k step)) ;; Fillet climbing out of the root onto the flank. (if (> rf 0.0) (setq pts (append pts (SpurGear:Fillet cen rr rf (- th (SpurGear:Psi rb rb n invphi)) -1.0 4)))) (setq pts (append pts (SpurGear:Flank cen th -1.0 rStartR ro rb n invphi 12))) ;; Across the tip. (setq tip (SpurGear:Psi ro rb n invphi)) (setq pts (append pts (SpurGear:Sweep cen ro (- th tip) (+ th tip) 3))) ;; Down the far flank - the same curve mirrored, so it is ;; generated root-upward and then turned round. (setq pts (append pts (reverse (SpurGear:Flank cen th 1.0 rStartR ro rb n invphi 12)))) ;; Fillet dropping back into the root. (if (> rf 0.0) (setq pts (append pts (reverse (SpurGear:Fillet cen rr rf (+ th (SpurGear:Psi rb rb n invphi)) 1.0 4))))) ;; Along the root to the foot of the next tooth. (setq pts (append pts (SpurGear:Sweep cen rr (+ th aGap) (+ th step (- aGap)) 3))) (setq k (1+ k))) (SpurGear:Poly pts lay t) ;; --- bore and keyway ------------------------------------ (initget 4) (setq bore (getdist cen (strcat "\nBore diameter, 0 for none <" (rtos (* 0.4 (* 2 rr)) 2 2) ">: "))) (if (null bore) (setq bore (* 0.4 (* 2 rr)))) (if (> bore 0.0) (progn (if (>= bore (* 2.0 rr)) (princ "\n** That bore is wider than the root circle. **")) (initget "Yes No") (setq keyW nil) (if (= "Yes" (getkword "\nCut a keyway [Yes/No] : ")) (progn ;; Square key to the usual rule of thumb: a ;; quarter of the shaft wide, half of that deep. (initget 6) (setq keyW (getdist (strcat "\nKey width <" (rtos (/ bore 4.0) 2 3) ">: "))) (if (null keyW) (setq keyW (/ bore 4.0))) (initget 6) (setq keyD (getdist (strcat "\nKey depth into the hub <" (rtos (/ keyW 2.0) 2 3) ">: "))) (if (null keyD) (setq keyD (/ keyW 2.0))) (if (>= keyW bore) (progn (princ "\n** Key is wider than the bore" " - drawing a plain bore. **") (setq keyW nil))))) (if (null keyW) (SpurGear:Circle cen (/ bore 2.0) lay) ;; Bore and keyway as ONE closed outline, so the ;; slot is genuinely open into the hole rather ;; than a rectangle sitting on top of an intact ;; circle. HALF is the half width, I the height ;; at which the slot walls meet the bore, and ;; V the half angle they subtend at the centre. (progn (setq half (/ keyW 2.0) yTop (+ (/ bore 2.0) keyD) i (sqrt (- (* (/ bore 2.0) (/ bore 2.0)) (* half half))) v (atan half i)) (SpurGear:Poly (append (list (list (- (car cen) half) (+ (cadr cen) yTop))) ;; The long way round the bore, from ;; the left wall anticlockwise all the ;; way back to the right wall. (SpurGear:Sweep cen (/ bore 2.0) (+ (/ pi 2.0) v) (+ (/ pi 2.0) v (- (* 2.0 pi) (* 2.0 v))) 48) (list (list (+ (car cen) half) (+ (cadr cen) yTop)))) lay t))))) ;; --- construction circles ------------------------------- (initget "Yes No") (if (/= "No" (getkword "\nShow pitch and base circles [Yes/No] : ")) (progn (SpurGear:Circle cen rp con) (SpurGear:Circle cen rb con))) ;; --- what it is ----------------------------------------- (princ (strcat "\n\n" (itoa n) " teeth, " (if metric (strcat "module " (rtos module 2 4)) (strcat "diametral pitch " (rtos dp 2 4))) ", " (rtos phi 2 1) " degree pressure angle." "\n Pitch diameter " (rtos (* 2.0 rp) 2 4) "\n Outside diameter " (rtos (* 2.0 ro) 2 4) "\n Root diameter " (rtos (* 2.0 rr) 2 4) "\n Base diameter " (rtos (* 2.0 rb) 2 4) "\n Circular pitch " (rtos (* pi module) 2 4) "\n Tooth thickness " (rtos (/ (* pi module) 2.0) 2 4) " at the pitch circle" "\n Root fillet " (rtos rf 2 4))) (if clipped (princ (strcat "\n Note: the teeth come to a point, so the" " tip was cut back by " (rtos clipped 2 4) ".\n More teeth or a coarser pitch would" " avoid it."))) (princ (strcat "\n A mate of the same pitch runs at a centre" " distance of\n " (rtos rp 2 4) " plus half its own pitch diameter.")) ) ) ) ) (SpurGear:Restore) (princ) ) (princ)