〖说明〗本例程能够根据给定的直径、齿数和角度绘制齿轮轮廓线。绘成 的轮廓是连续的polyline，能方便地进行三维延伸等处理。不过其中曲线生成采用的数据是根据美国机械行业标准，用的时候可能要根据自己的需要修改。www.goodsgy.com

    〖安装〗将"程序代码"一节的文本裁剪下来，保存成名为"SUPRGEAR.LSP"的 文本文件；将这个文件拷贝到AutoCAD的系统目录中。www.goodsgy.com

    〖使用〗在AutoCAD命令行键入：（load "suprgear"）www.goodsgy.com

    然后执行：SG，按程序中的提示操作即可。www.goodsgy.com

    〖程序代码〗；；；begain suprgear.lsp；*************************************************；SPURGEAR.LSP - a lisp program by Tony Hotchkiss；——； This routine draws a spur gear using joined； polylines. It lets you use any pressure angle； to design the gear teeth.；*************************************************（defun err （s）www.goodsgy.com

    （if （= s "Function cancelled"）www.goodsgy.com

    （princ "\nSPURGEAR - cancelled： "）www.goodsgy.com

    （progn （princ "\nSPURGEAR - Error： "） （princ s）www.goodsgy.com

    （terpri）））； if（resetting）www.goodsgy.com

    （princ "SYSTEM VARIABLES have been reset\n"）www.goodsgy.com

    （princ））； errwww.goodsgy.com

    （defun setv （systvar newval）www.goodsgy.com

    （setq x （read （strcat systvar "1"）））www.goodsgy.com

    （set x （getvar systvar））www.goodsgy.com

    （setvar systvar newval））； setvwww.goodsgy.com

    （defun setting （）www.goodsgy.com

    （setq oerr *error*）www.goodsgy.com

    （setq *error* err）www.goodsgy.com

    （setv "CMDECHO" 0）www.goodsgy.com

    （setv "BLIPMODE" 0））； end of setting（defun rsetv （systvar）www.goodsgy.com

    （setq x （read （strcat systvar "1"）））www.goodsgy.com

    （setvar systvar （eval x）））； restv（defun resetting （）www.goodsgy.com

    （rsetv "CMDECHO"）www.goodsgy.com

    （rsetv "BLIPMODE"）www.goodsgy.com

    （setq *error* oerr））； end of resettingwww.goodsgy.com

    （defun dxf （code ename）www.goodsgy.com

    （cdr （assoc code （entget ename））））； dxfwww.goodsgy.com

    （defun spurgear （/ D N phi DO RO A B DR DB inv-plst p1 trimcode invent p0 p curvent linent linent2 ent2 p2）www.goodsgy.com

    （setq D （getreal "\nPitch diameter： "）www.goodsgy.com

    N （getint "\nNumber of teeth： "）www.goodsgy.com

    phi （getreal "\nPressure angle： "）www.goodsgy.com

    phi （* （/ phi 180） pi） ； Pressure angle DO （* D （+ （/ 2.0 N） 1.0））； Outside diameter RO （/ DO 2.0） ； Outside radius A （/ D N） ； Addendum B （* 1.25 A） ； Dedendum DR （- D （* B 2.0）） ； Root diameter DB （* D （cos phi）） ； Base circle dia. inv-plst （involute DB N phi）；involute points trimcode nil）； setq（command "ZOOM" （list 0 （- B））www.goodsgy.com

    （list RO （/ RO 1.5）））； command（setq invent （draw-inv inv-plst））； Draw involute.（setq p0 （car inv-plst）www.goodsgy.com

    trimcode （ext-trim p0 DR D）；trim or extend）； setq ； the involute.（if （and trimcode （= trimcode 0））www.goodsgy.com

    （progn ； Joins the involute to the extension.（setq p （list （/ DR 2.0） 0））www.goodsgy.com

    （command "PEDIT" p "Y" "J" invent "" "X"）www.goodsgy.com

    （setq curvent （entlast）））； progn（setq curvent （entlast）））； if（if （null trimcode） （setq curvent invent））www.goodsgy.com

    （setq linent （draw-top-line D DB N RO））； top line.（command "COPY" linent "" "0，0" "0，0"）www.goodsgy.com

    （setq linent2 （entlast））www.goodsgy.com

    （setq ent2 （mir-it curvent linent））； mirror curve（command "PEDIT" curvent "J" linent ent2 "" "X"）www.goodsgy.com

    （segment DR N linent2） ； Finish the job！www.goodsgy.com

    （setq p1 （list （- RO） （- RO）））www.goodsgy.com

    （setq p2 （list RO RO））www.goodsgy.com

    （command "ZOOM" p1 p2）www.goodsgy.com

    （prompt "\nConverting to POLYLINE， please wait……"）www.goodsgy.com

    （command "PEDIT" （entlast） "J" "C" p1 p2 "" "X"）www.goodsgy.com

    （prompt "\nAll done！"））； spurgearwww.goodsgy.com

    （defun involute （DB N phi / numer denom frac theta2max thetamax theta-inc theta plist RB xval yval p）www.goodsgy.com

    （setq invfact 3）www.goodsgy.com

    （setq numer （+ N 2.0）www.goodsgy.com

    denom （* N （cos phi））www.goodsgy.com

    frac （/ numer denom）www.goodsgy.com

    theta2max （- （* frac frac） 1）www.goodsgy.com

    thetamax （sqrt theta2max）www.goodsgy.com

    theta-inc （/ thetamax （float invfact））www.goodsgy.com

    theta 0 plist nil RB （/ DB 2.0））； setq（repeat （1+ invfact）www.goodsgy.com

    （setq xval （do-x RB theta）www.goodsgy.com

    yval （do-y RB theta）www.goodsgy.com

    p （list xval yval）www.goodsgy.com

    plist （append plist （list p）））； setq（setq theta （+ theta theta-inc）））； repeat plist）； involutewww.goodsgy.com

    （defun do-x （RB theta）www.goodsgy.com

    （* RB （+ （cos theta） （* theta （sin theta）））））； do-xwww.goodsgy.com

    （defun do-y （RB theta）www.goodsgy.com

    （* RB （- （sin theta） （* theta （cos theta）））））； do-ywww.goodsgy.com

    （defun draw-inv （inv-plst / dirpt plist p）www.goodsgy.com

    （command "PLINE" （nth 0 inv-plst））www.goodsgy.com

    （setq dirpt （polar （nth 0 inv-plst） 0 1））www.goodsgy.com

    （command "A" "D" dirpt）www.goodsgy.com

    （setq plist （cdr inv-plst））www.goodsgy.com

    （foreach p plist （command p））www.goodsgy.com

    （command ""）www.goodsgy.com

    （entlast））； draw-invwww.goodsgy.com

    （defun ext-trim （p0 DR D / trimcode dist endr）www.goodsgy.com

    （if （> （car p0） （/ DR 2.0）） ； Extends the involute（progn（command "LINE" （list （/ DR 2.0） 0） p0 ""）www.goodsgy.com

    （setq trimcode 0））； progn）； if（if （< （car p0） （/ DR 2.0）） ； Trims the involute（progn（command "CIRCLE" "0，0" "D" DR）； Root circle（setq dist （- （/ D 2.0） （car p0）））www.goodsgy.com

    （command "ZOOM" p0（polar p0 0.6 dist））www.goodsgy.com

    （setq endr （entlast））www.goodsgy.com

    （command "TRIM" endr "" p0 ""）www.goodsgy.com

    （command "ZOOM" "P"）www.goodsgy.com

    （entdel endr）www.goodsgy.com

    （setq trimcode 1））； progn）； if trimcode）； ext-trimwww.goodsgy.com

    （defun draw-top-line （D DB N RO / theta-p xp yp alpha beta tang angend inv-endpt lend）www.goodsgy.com

    （setq theta-p （sqrt （- （* （/ D DB） （/ D DB）） 1.0））www.goodsgy.com

    xp （do-x （/ DB 2.0） theta-p）； This section yp （do-y （/ DB 2.0） theta-p）； sets up angles alpha （atan yp xp） ； for drawing a abeta （angle （list 0 0） （last inv-plst））www.goodsgy.com

    beta （- abeta alpha） ； line across the tang （/ pi N） ； top of a tooth angend （- （+ alpha tang） beta）www.goodsgy.com

    inv-endpt （last inv-plst）； This also creates lend （polar （list 0 0） angend RO）； the tooth）； setq ； thickness.（command "LINE" inv-endpt lend ""）； Draws the line（redraw）www.goodsgy.com

    （entlast））； draw-top-linewww.goodsgy.com

    （defun mir-it （cvent linent / pt）www.goodsgy.com

    （setq pt （dxf 11 linent））www.goodsgy.com

    （command "MIRROR" cvent "" "MID" pt "0，0" ""）www.goodsgy.com

    （entlast））； mir-itwww.goodsgy.com

    （defun segment （DR N en / p1 p2 ang dist midp p0 pang pang2 p p3 ent3 entl1 entl2 en1 en2）www.goodsgy.com

    （setq p1 （dxf 10 en）www.goodsgy.com

    p2 （dxf 11 en）www.goodsgy.com

    ang （angle p1 p2）www.goodsgy.com

    dist （/ （distance p1 p2） 2.0）www.goodsgy.com

    midp （polar p1 ang dist）www.goodsgy.com

    p0 （list 0 0）www.goodsgy.com

    pang （angle p0 midp）www.goodsgy.com

    pang2 （/ pi N）www.goodsgy.com

    p （polar p0 pang （/ DR 2.0））www.goodsgy.com

    p1 （polar p0 （- pang pang2） （/ DR 2.0））www.goodsgy.com

    p2 （polar p0 （+ pang pang2） （/ DR 2.0））www.goodsgy.com

    p3 （polar p0 （+ pang pang2 pang2） （/ DR 2.0））www.goodsgy.com

    ent3 （entlast）； This is the tooth p-line）； setq（command "ZOOM" "W" p3 p1）www.goodsgy.com

    （command "CIRCLE" "0，0" "D" DR） ；Root circle（command "TRIM" ent3 "" p ""）； Trim the root circle（command "ZOOM" "P"）www.goodsgy.com

    （command "LINE" p0 p1 ""）www.goodsgy.com

    （setq entl1 （entlast））www.goodsgy.com

    （command "LINE" p0 p2 ""）www.goodsgy.com

    （setq entl2 （entlast））www.goodsgy.com

    （command "TRIM" entl1 entl2 "" p3 ""）www.goodsgy.com

    （entdel entl1）www.goodsgy.com

    （entdel entl2）www.goodsgy.com

    （entdel en）www.goodsgy.com

    （command "ZOOM" "W" p3 p1）www.goodsgy.com

    （command "PEDIT" p1 "Y" "X"）www.goodsgy.com

    （setq en1 （entlast））www.goodsgy.com

    （command "PEDIT" p2 "Y" "X"）www.goodsgy.com

    （setq en2 （entlast））www.goodsgy.com

    （command "PEDIT" en1 "J" midp en2 "" "X"）www.goodsgy.com

    （command "ZOOM" "P"）www.goodsgy.com

    （command "ARRAY" p1 "" "P" "0，0" N "360" "Y"））； segmentwww.goodsgy.com

    （defun c：sg （）www.goodsgy.com

    （setting）www.goodsgy.com

    （spurgear）www.goodsgy.com

    （resetting）www.goodsgy.com

    （princ））； c：sgwww.goodsgy.com

    （prompt "\n**SPURGEAR.LSP Loaded！"）www.goodsgy.com

    （prompt "\n Enter 'SG' to start"）www.goodsgy.com

    ；；；end suprgear.lspwww.goodsgy.com