请大神指点,这个autolisp源程序哪里有问题,并把它修改一下。

把阵列的功能也加进去,让它自己能够画一个完整的齿轮。谢谢,好的回答会追加分。(defunc:gear(/)(setqp0(getpoint"/*输入齿轮中心p0:*/")... 把阵列的功能也加进去,让它自己能够画一个完整的齿轮。谢谢,好的回答会追加分。
(defun c:gear(/)
(
setq
p0 (getpoint"/*输入齿轮中心p0:*/ ")
m (getreal"输入齿轮模数M: ")
z (getint"输入齿轮齿数Z: ")
ha 1
c 0.25
a (/ pi 9)
ra (/ (* (+ z (+ ha ha)) m) 2)
rf (/ (* (- z(+ (+ ha ha) c)) m) 2)
r (/ ( * m z) 2)
rb ( * r (cos a))
ri rb
ang 0
g (polar p0 ang rb)
)
(command "circle" p0 ra)
(command "circle" p0 rf)
(command "circle" p0 r)
(command "line" g)
(while (< ri ra)
(
setq
ang ( + ang(/ pi 180))
ri (/ rb ('o sang))
cta ( - (/ (sin ang) ('o sang)) ang)
g (polar p0 cta ri)
)
(command g)
)
(command )
)
展开
 我来答
pzweng
2013-04-06 · TA获得超过1988个赞
知道小有建树答主
回答量:677
采纳率:90%
帮助的人:342万
展开全部
(defun c:cw ()
(setvar "cmdecho" 0)
;;;获得已知参数
(setq c (getpoint "\n 请指定标准齿轮中心点<0,0>:"))
(if (null c) (setq c '(0 0)))
(setq m (getreal "\n 请指定轮齿模数<2.5>:"))
(if (null m) (setq m 2.5))
(setq z (getint "\n 请确定齿数<20>:"))
(if (null z) (setq z 20))
;;;计算齿轮参数
(setq d (* m z))
(setq ha m)
(setq hf (* m 1.25))
(setq da (+ d ha ha))
(setq df (- d hf hf))
(setq db (* d (cos (* (/ pi 180) 20))))
;;;计算过程参数
(setq b (* db 0.5))
(setq c1 (* da 0.5))
(setq c2 (* d 0.5))
(setq c3 (* df 0.5))
(setq a (sqrt (- (* c2 c2) (* b b))))
(setq zc1 (* 0.5 (+ a b c1)));;;zc为计算三角形周长的一半
(setq zc2 (* 0.5 (+ a b c2)))
(setq zc3 (* 0.5 (+ a b c3)))
(setq s1 (sqrt (* zc1 (- zc1 a) (- zc1 b) (- zc1 c1))))
(setq s2 (sqrt (* zc2 (- zc2 a) (- zc2 b) (- zc2 c2))))
(setq s3 (sqrt (* zc3 (- zc3 a) (- zc3 b) (- zc3 c3))))
(setq h1 (/ (* s1 2) c1))
(setq h2 (/ (* s2 2) c2))
(setq h3 (/ (* s3 2) c3))
(setq w1 (sqrt (- (* b b) (* h1 h1))))
(setq w2 (sqrt (- (* b b) (* h2 h2))))
(setq w3 (sqrt (- (* b b) (* h3 h3))))
(setq ang (* pi (/ (- (/ 360 (* z 4)) 0.02) 180)))
(setq ang1 (atan (/ h1 w1)))
(setq ang2 (atan (/ h2 w2)))
(setq ang3 (atan (/ h3 w3)))
(setq z1 (- ang2 ang1))
(setq z2 (- ang3 ang2))
(setq a1 (- ang z1))
(setq a3 (+ ang z2))
(setq angz (/ (* pi 2) z))
(setq angs (* a3 2))
(setq angc (- angz angs))
;;;计算绘图点
(setq b1 (polar c (- 0 a1) c1))
(setq b2 (polar c (- 0 ang) c2))
(setq b3 (polar c (- 0 a3) c3))
(setq p (polar c 0 c1))
(setq pt1 (polar c (+ 0 a1) c1))
(setq pt2 (polar c (+ 0 ang) c2))
(setq pt3 (polar c (+ 0 a3) c3))
(setq pt4 (polar c (+ 0 angc a3) c3))
;;;开始绘制轮齿
(command "layer" "M" "3中心线" "C" 4 "" "L" "center" "" "")
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(command "clayer" "0")
(command "pline" b3 "w" 0 "" "a" "s" b2 b1 "s" p pt1 "s" pt2 pt3 "ce" c pt4 "")
(command "array" (entlast) "" "p" c z "" "")
(command "circle" c "d" c2)
(command "clayer" "中心线")
(command "circle" c c2)
(setvar "osmode" os)
(princ)
)
名片
2024-10-28 广告
正版Hyperworks软件多少钱,购买正版Hyperworks软件,免费咨询Altair Hyperworks软件中国区网站首页,HyperWorks软件提供了完整的CAE有限元分析解决方案,免费试用和咨询官网。... 点击进入详情页
本回答由名片提供
推荐律师服务: 若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询

为你推荐:

下载百度知道APP,抢鲜体验
使用百度知道APP,立即抢鲜体验。你的手机镜头里或许有别人想知道的答案。
扫描二维码下载
×

类别

我们会通过消息、邮箱等方式尽快将举报结果通知您。

说明

0/200

提交
取消

辅 助

模 式