[求助]：请教 怎样用Lisp绘制齿轮并允许用户输入所需要的参数

Wolf66886

怎样用Lisp绘制齿轮并允许用户输入所需要的参数



各位高手请帮帮小弟~~~





谢谢！！

lsjjm

请参考:

(defun c:test ()
  (setq p1        (getpoint         "\nPick centre point of gear"))
  (setq n         (getint                "\nNumber of teeth:"))
  (setq mod        (getreal        "\nModule:"))
  (setq gh        (getint                "\nHeight of gear:"))
  (setq d1         (getreal        "\nShaft diameter:"))
  (setq oc         (* (+ n 2)mod))
  (if (>= mod 1.25) (setq ht 2.25) (setq ht 2.4))
  (setq h         (* ht mod))
  (setq ic        (- oc(* 2 h)))
  (setq pc        (* n mod))
  (setq cp         (* pi mod))
  (defun error_messages ()
    (if (>= d1 ic) (alert "Shaft diameter is to large!"))
    (setq x1 0)
  )
  (setq h1         (/ oc 2))
  (setq h11        (/ ic 2))
  (setq h2         (* 0.14175 cp))
  (setq h22         (* 0.2835 cp))
  (setq h3          (* 2 h2))
  (setq h4         (/ h3 ic))
  (setq h5        (* 2 oc))
  (setq h6          (* h1 1.2))
  (setq h7         (*(* h6 h6)2))
  (setq h8        (sqrt h7))
  (setq p2         (list (car p1)                  (+ (cadr p1) h1)))
  (setq p21         (list (car p1)                  (+ (cadr p1) h11)))
  (setq p3         (list (+ (car p2) h2)                  (cadr p2)))
  (setq p4           (list (+ (car p21) h22)         (cadr p21)))
  (setq p5         (list (+ (car p4) h3)                  (- (cadr p4) h4)))
  (setq z1        (polar p1 5.497787144 h8))
  (setq z2         (polar p1 2.35619449 h8))
  (setq w1        (list (* (car p1) 1)                 (* (cadr p1) 1)))
  (setq w2        (list (* (car p1)1000)                  (* (cadr p1)1000)))
  (command "zoom" "w" w1 w2)  
  (error_messages)
  (command "pline"  p2 p3 p4 "")
  (setq s1 (entlast))
  (command "mirror" "L"  "" p1 p2 "n" "")
  (setq s2 (entlast))
  (command "pedit" "L" "J" s1 s2 "" "")
  (setq s21(entlast))
  (command "array"  "L" "" "p" p1 n "" "Y")
  (setvar        "osmode" 0)
  (setvar  "osmode" 1)
  (command "pline" p4 p5 "")
  (setvar "osmode" 0)
  (command "array" "L" "" "p" p1 n "" "Y")
  (setq s3 (entlast))
  (command "zoom" "e")
  (command "pedit" s21 "J" "C" z1 z2 "" "")
  (command "extrude" "L" "" gh "")
  (command "circle" p1 "d" d1)
  (command "extrude" "L" "" gh "")
  (command "vpoint" "r" "200" "45" )
  (command "hide")
)

guanzhangyang

看看这个，LSP：
(defun err (s)
(if (= s "Function cancelled")
(princ "\nSPURGEAR - cancelled: ")
(progn (princ "\nSPURGEAR - Error: ") (princ s)
(terpri))
); if )
(resetting)
(princ "SYSTEM VARIABLES have been reset\n")
(princ)
); err </P><P>(defun setv (systvar newval)
(setq x (read (strcat systvar "1")))
(set x (getvar systvar))
(setvar systvar newval)
); setv </P><P>(defun setting ()
(setq oerr *error*)
(setq *error* err)
(setv "CMDECHO" 0)
(setv "BLIPMODE" 0)
); end of setting
(defun rsetv (systvar)
(setq x (read (strcat systvar "1")))
(setvar systvar (eval x))
); restv
(defun resetting ()
(rsetv "CMDECHO")
(rsetv "BLIPMODE")
(setq *error* oerr)
); end of resetting </P><P>(defun dxf (code ename)
(cdr (assoc code (entget ename)))
); dxf </P><P>(defun spurgear (/ D N phi DO RO A B DR DB inv-plst p1
trimcode invent p0 p curvent linent linent2 ent2 p2)
(setq D (getreal "\nPitch diameter: ")
N (getint "\nNumber of teeth: ")
phi (getreal "\nPressure angle: ")
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 (- )
(list RO (/ RO 1.5))
); command
(setq invent (draw-inv inv-plst)); Draw involute.
(setq p0 (car inv-plst)
trimcode (ext-trim p0 DR D);trim or extend
); setq ; the involute.
(if (and trimcode (= trimcode 0))
(progn ; Joins the involute to the extension.
(setq p (list (/ DR 2.0) 0))
(command "PEDIT" p "Y" "J" invent "" "X")
(setq curvent (entlast))
); progn
(setq curvent (entlast))
); if
(if (null trimcode) (setq curvent invent))
(setq linent (draw-top-line D DB N RO)); top line.
(command "COPY" linent "" "0,0" "0,0")
(setq linent2 (entlast))
(setq ent2 (mir-it curvent linent)); mirror curve
(command "PEDIT" curvent "J" linent ent2 "" "X")
(segment DR N linent2) ; Finish the job!
(setq p1 (list (- RO) (- RO)))
(setq p2 (list RO RO))
(command "ZOOM" p1 p2)
(prompt "\nConverting to POLYLINE, please wait...")
(command "PEDIT" (entlast) "J" "C" p1 p2 "" "X")
(prompt "\nAll done!")
); spurgear </P><P>(defun involute (DB N phi / numer denom frac theta2max
thetamax theta-inc theta plist RB xval yval p)
(setq invfact 3)
(setq numer (+ N 2.0)
denom (* N (cos phi))
frac (/ numer denom)
theta2max (- (* frac frac) 1)
thetamax (sqrt theta2max)
theta-inc (/ thetamax (float invfact))
theta 0
plist nil
RB (/ DB 2.0)
); setq
(repeat (1+ invfact)
(setq xval (do-x RB theta)
yval (do-y RB theta)
p (list xval yval)
plist (append plist (list p))
); setq
(setq theta (+ theta theta-inc))
); repeat
plist
); involute </P><P>(defun do-x (RB theta)
(* RB (+ (cos theta) (* theta (sin theta))))
); do-x </P><P>(defun do-y (RB theta)
(* RB (- (sin theta) (* theta (cos theta))))
); do-y </P><P>(defun draw-inv (inv-plst / dirpt plist p)
(command "PLINE" (nth 0 inv-plst))
(setq dirpt (polar (nth 0 inv-plst) 0 1))
(command "A" "D" dirpt)
(setq plist (cdr inv-plst))
(foreach p plist (command p))
(command "")
(entlast)
); draw-inv </P><P>(defun ext-trim (p0 DR D / trimcode dist endr)
(if (> (car p0) (/ DR 2.0)) ; Extends the involute
(progn
(command "LINE" (list (/ DR 2.0) 0) p0 "")
(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)))
(command "ZOOM" p0
(polar p0 0.6 dist))
(setq endr (entlast))
(command "TRIM" endr "" p0 "")
(command "ZOOM" "P")
(entdel endr)
(setq trimcode 1)
); progn
); if
trimcode
); ext-trim </P><P>(defun draw-top-line (D DB N RO / theta-p xp yp alpha
beta tang angend inv-endpt lend)
(setq theta-p (sqrt (- (* (/ D D (/ D D) 1.0))
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))
beta (- abeta alpha) ; line across the
tang (/ pi N) ; top of a tooth
angend (- (+ alpha tang) beta)
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)
(entlast)
); draw-top-line </P><P>(defun mir-it (cvent linent / pt)
(setq pt (dxf 11 linent))
(command "MIRROR" cvent "" "MID" pt "0,0" "")
(entlast)
); mir-it </P><P>(defun segment (DR N en / p1 p2 ang dist midp p0 pang
pang2 p p3 ent3 entl1 entl2 en1 en2)
(setq p1 (dxf 10 en)
p2 (dxf 11 en)
ang (angle p1 p2)
dist (/ (distance p1 p2) 2.0)
midp (polar p1 ang dist)
p0 (list 0 0)
pang (angle p0 midp)
pang2 (/ pi N)
p (polar p0 pang (/ DR 2.0))
p1 (polar p0 (- pang pang2) (/ DR 2.0))
p2 (polar p0 (+ pang pang2) (/ DR 2.0))
p3 (polar p0 (+ pang pang2 pang2) (/ DR 2.0))
ent3 (entlast); This is the tooth p-line
); setq
(command "ZOOM" "W" p3 p1)
(command "CIRCLE" "0,0" "D" DR) ;Root circle
(command "TRIM" ent3 "" p ""); Trim the root circle
(command "ZOOM" "P")
(command "LINE" p0 p1 "")
(setq entl1 (entlast))
(command "LINE" p0 p2 "")
(setq entl2 (entlast))
(command "TRIM" entl1 entl2 "" p3 "")
(entdel entl1)
(entdel entl2)
(entdel en)
(command "ZOOM" "W" p3 p1)
(command "PEDIT" p1 "Y" "X")
(setq en1 (entlast))
(command "PEDIT" p2 "Y" "X")
(setq en2 (entlast))
(command "PEDIT" en1 "J" midp en2 "" "X")
(command "ZOOM" "P")
(command "ARRAY" p1 "" "P" "0,0" N "360" "Y")
); segment </P><P>(defun c:sg ()
(setting)
(spurgear)
(resetting)
(princ)
); c:sg </P><P>(prompt "\n**SPURGEAR.LSP Loaded!")
(prompt "\n Enter 'SG' to start")
;;;end suprgear.lsp

这个是用VBA做的：
Dim ra, rk, rb, rf As Double
Dim z, m, h, d1, c As Double
Private Sub CommandButton1_Click()
z = TextBox1.Text
m = TextBox2.Text
h = TextBox3.Text
d1 = TextBox4.Text
c = TextBox5.Text
ThisDrawing.SendCommand "filedia 0 "
Open "zc.scr" For Output As #1
'Call jb
Call zc
Call hq
Close #1
UserForm1.hide
ThisDrawing.SendCommand "script zc" + Chr$(13)
End Sub
Sub jb() '基本约定
Print #1, "filedia"
Print #1, "0"
Print #1, "snap"
Print #1, "off"
Print #1, "osnap"
Print #1, "off"
Print #1, "grid"
Print #1, "off"
Print #1, "ortho"
Print #1, "off"
Print #1, "osnapcoord"
Print #1, "1"
Print #1, "trackpath"
Print #1, "3"
Print #1, "blipmode"
Print #1, "off"

'基本设置
Print #1, "layer"
Print #1, "m"
Print #1, "0"
Print #1, "l"
Print #1, "centerx2"
Print #1, ""
Print #1, "color"
Print #1, "1"
Print #1, ""
Print #1, ""
Print #1, "layer"
Print #1, "m"
Print #1, "1"
Print #1, "l"
Print #1, "dashed"
Print #1, ""
Print #1, "color"
Print #1, "2"
Print #1, ""
Print #1, ""
Print #1, "layer"
Print #1, "m"
Print #1, "2"
Print #1, "l"
Print #1, "coutinuous"
Print #1, ""
Print #1, "color"
Print #1, "5"
Print #1, ""
Print #1, ""
Print #1, "layer"
Print #1, "m"
Print #1, "3"
Print #1, "l"
Print #1, "coutinuous"
Print #1, ""
Print #1, "color"
Print #1, "7"
Print #1, ""
Print #1, ""
Print #1, "layer"
Print #1, "m"
Print #1, "4"
Print #1, "l"
Print #1, "coutinuous"
Print #1, ""
Print #1, "color"
Print #1, "7"
Print #1, ""
Print #1, ""
End Sub
Sub zc()
pi = 3.1415926
con = pi / 180
aha = 20 * con
r = z * m / 2
rb = r * Cos(aha)
ra = r + m
rf = r - 1.25 * m
s = pi * m / 2
Print #1, "pline"
rr$ = LTrim$(Str$(ra))
Print #1, rr$; ",0"
'rk = rb / Cos(ahak) '''''''''''''''''''''
sitaa = sita(ra)
rt = (ra - rb) / 20
For i = 1 To 20
rk = ra - rt * i
sitak = sita(rk)
sitak = sitaa - sitak
ri$ = LTrim$(Str$(rk))
sitai$ = LTrim$(Str$(sitak / con))
Print #1, ri$; "<"; sitai$
Next i

'齿根
pb = pi * m * Cos(aha)
sitar = sita(r)
sitab = sita(rb)
sb = s * rb / r - 2 * rb * (sitab - sitar)
phab = sb / rb
pha1 = (2 * pi / z - phab)
ri$ = LTrim$(Str$(rf + 2))
sitai$ = LTrim$(Str$((sitaa + pha1 / 10) / con))
Print #1, ri$; "<"; sitai$
ri$ = LTrim$(Str$(rf + 1))
sitai$ = LTrim$(Str$((sitaa + 2 * pha1 / 10) / con))
Print #1, ri$; "<"; sitai$
ri$ = LTrim$(Str$(rf))
ang$ = LTrim$(Str$(pha1 * 6 / 10 / con))
Print #1, "a"
Print #1, "ce"
Print #1, "0,0"
Print #1, "a"
Print #1, ang$
'齿廓另一侧
Print #1, "l"
ri$ = LTrim$(Str$(rf + 1))
sitai$ = LTrim$(Str$((sitaa + pha1 * 9 / 10) / con))
Print #1, ri$; "<"; sitai$
ri$ = LTrim$(Str$(rf + 2))
sitai$ = LTrim$(Str$((sitaa + pha1) / con))
Print #1, ri$; "<"; sitai$
pha2 = sitak + pha1
For i = 1 To 20
rk = rb + rt * i
sitak = sita(rk)
sitak = pha2 + sitak
ri$ = LTrim$(Str$(rk))
sitai$ = LTrim$(Str$(sitak / con))
Print #1, ri$; "<"; sitai$
Next i

'齿顶
sitaa = sita(ra)
sa = s * ra / r - 2 * ra * (sitaa - sitar)
phaa = sa / ra
ang$ = LTrim$(Str$(phaa / con))
Print #1, "a"
Print #1, "ce"
Print #1, "0,0"
Print #1, "a"
Print #1, ang$
Print #1, ""
'轮齿阵列
Print #1, "array"
Print #1, "0,0"
Print #1, rr$; ","; rr$
Print #1, ""
Print #1, "p"
Print #1, "0,0"
zz$ = LTrim$(z)
Print #1, zz$
Print #1, ""
Print #1, ""
'齿廓边界
Print #1, "zoom"
Print #1, "a"
Print #1, "boundary"
Print #1, "a"
Print #1, "b"
Print #1, "n"
Print #1, "-"; rr$; ",-"; rr$
Print #1, rr$; ","; rr$
Print #1, ""
Print #1, ""
Print #1, "0,0"
Print #1, ""
'棉域化
Print #1, "region"
Print #1, rr$; ",0"
Print #1, ""
'拉伸
Print #1, "extrude"
Print #1, rr$; ",0"
Print #1, ""
hh$ = LTrim$(h)
Print #1, hh$
Print #1, ""
'画轮抽两端
Print #1, "cylinder"
dd1$ = LTrim$(2 * d1)
Print #1, "0,0,-"; dd1$
dd1$ = LTrim$(d1)
Print #1, dd1$
dd1$ = LTrim$(4 * d1 + h)
Print #1, dd1$

Print #1, "cylinder"
dd1$ = LTrim$(10)
Print #1, "0,0,-"; dd1$
dd1$ = LTrim$(1.2 * d1)
Print #1, dd1$
dd1$ = LTrim$(h + 20)
Print #1, dd1$
End Sub
Public Sub hq()
Print #1, "shademode"
Print #1, "g"
Print #1, "ucsicon"
Print #1, "off"
Print #1, "view"
Print #1, "swiso"
i = 0.5
pi = 3.1415926
Do While i < 180
  Print #1, "camera"
  a = LTrim$(600 * Sin(i * 180 / pi))
  b = LTrim$(600 * Cos(i * 180 / pi))
Print #1, a; ","; b; ","; "120"
Print #1, "0,0,0"
i = i + 0.5
Loop
End Sub
Function sita(rb)
Dim x As Double
rk = rb / Cos(ahak)
x = rb / rk
x = Sqr((1 - x * x) / x)
ahak = Atn(x)
sita = Tan(ahak) - ahak
End Function

Wolf66886

多谢几位高手     特别是3楼的高手...........................





小弟非常感谢~~~~~~~~~~

月半弯

哈哈

小鬼头

这个lisp程序直接拷贝过去好像用不成啊

zhaoyafei19

我是菜鸟
希望转为直接的程序

等你爱我

好用吗！！


多次重复发帖！[/COLOR]

huanghe0713

不知道怎么用啊！！给个说明啊