画链轮.lsp
;;其它论坛有画链轮的程序，明经论坛也应该有;;曾经有一段时间，我常画链轮，须不复杂，每次计算确很繁琐,所以关注它
;;希望改编后的程序更完善
;;画链轮 自贡黄明儒 2012.12.07
(defun c:Draw_Chain (/ B1 CMDECHO1 DR H M NO OSMODE1 P P0 PT Z)
(setq cmdecho1 (getvar "cmdecho"))
(setq osmode1 (getvar "osmode"))
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(initget "08A 10A 12A 16A 20A 24A 28A 32A 40A 48A")
(setq
no
(getkword
"\n 请输入链号<08A>:"
)
)
(if (= no nil)
(setq no "08A")
)
(if (setq z (getint "\n 请输入齿数<12>:"))
nil
(setq z 12)
)
(if (setq m (getint "\n 请输入排数<1>:"))
nil
(setq m 1)
)
(setq no (strcase no))
(cond ((= no "08A")
(setq p 12.7)
(setq dr 7.95)
(setq pt 14.38)
(setq b1 7.85)
(setq h 12.07)
)
((= no "10A")
(setq p 15.875)
(setq dr 10.16)
(setq pt 18.11)
(setq b1 9.4)
(setq h 15.09)
)
((= no "12A")
(setq p 19.05)
(setq dr 11.91)
(setq pt 22.78)
(setq b1 12.57)
(setq h 18.08)
)
((= no "16A")
(setq p 25.4)
(setq dr 15.88)
(setq pt 29.29)
(setq b1 15.75)
(setq h 24.13)
)
((= no "20A")
(setq p 31.75)
(setq dr 19.05)
(setq pt 35.76)
(setq b1 18.9)
(setq h 30.18)
)
((= no "24A")
(setq p 38.1)
(setq dr 22.23)
(setq pt 45.44)
(setq b1 25.22)
(setq h 36.2)
)
((= no "28A")
(setq p 44.45)
(setq dr 25.4)
(setq pt 48.87)
(setq b1 25.22)
(setq h 42.24)
)
((= no "32A")
(setq p 50.8)
(setq dr 28.585)
(setq pt 58.55)
(setq b1 31.55)
(setq h 48.26)
)
((= no "40A")
(setq p 63.5)
(setq dr 39.68)
(setq pt 71.55)
(setq b1 37.85)
(setq h 60.33)
)
(t
(setq p 76.2)
(setq dr 47.63)
(setq pt 87.83)
(setq b1 47.35)
(setq h 72.39)
)
)
(if (setq p0 (Draw_Chain1 p dr pt b1 z m)) ;用于正视图中心点
(Draw_Chain2 p0 p dr pt b1 z h)
)
(setvar "cmdecho" cmdecho1)
(setvar "osmode" osmode1)
(princ)
)
(defun Draw_Chain1 (p dr pt b1 z m / ANGANG1 BA
BF1 BFMCLAYER D DA DF DG EN1 EN2
EN3 H L M1 M2 O1 O2 PT1PT10 PT11
PT12 PT2PT3PT4 PT5PT6PT7PT8PT9 RA
X1 X2 XB
)
(cond ((= m 1) (setq bf1 (* 0.93 b1)))
((= m 2) (setq bf1 (* 0.91 b1)))
((= m 3) (setq bf1 (* 0.91 b1)))
((>= m 4) (setq bf1 (* 0.88 b1)))
(t (setq bf1 (* 0.93 b1)))
)
(setq ba (* p 0.125))
(setq h (* p 0.5))
(setq ra (* p 0.04))
(setq bfm (+ bf1 (* pt (- m 1))))
(setq ang1 (/ pi z)) ;ang1为180/z的弧度值
(setq d (/ p (sin ang1)))
(setq da (fix (- (+ d (* p 1.25)) dr)))
(setq df (- d dr))
(setq dg (fix (- (* p (/ (cos ang1) (sin ang1))) (* h 1.04) 0.76 dr)))
(and (setq pt1 (getpoint "\n 请输入起点:"))
(setq pt2 (getpoint pt1 "\n 请输入链轮宽度:"))
(setq l (distance pt1 pt2))
(setq ang (angle pt1 pt2))
(setq pt3 (polar pt1 (+ (* pi 0.5) ang) (/ df 2)))
(setq pt4 (polar pt3 (+ (* pi 0.5) ang) (- (/ (- da df) 2) h)))
(setq x1 (polar pt1 (+ ang (* 0.5 pi)) (/ da 2)))
(setq x2 (polar x1 ang bf1))
(setq xb (polar pt1 ang bf1))
(setq m1 (polar pt1 (+ ang pi) 2))
(setq m2 (polar xb ang 2))
(setq pt5 (polar x1 ang ba))
(setq pt6 (polar pt5 ang (- bf1 (* ba 2))))
(setq pt7 (polar pt4 ang bf1))
(setq pt8 (polar pt3 ang bf1))
(setq pt9 (polar xb (+ ang (* pi 0.5)) (/ dg 2)))
(setq pt10 (polar pt2 (+ ang (* 0.5 pi)) (/ dg 2)))
(setq pt11 (polar pt2 (+ ang (* 1.5 pi)) (/ dg 2)))
(setq pt12 (polar xb (+ ang (* 1.5 pi)) (/ dg 2)))
(setq o1 (polar pt7 (+ ang pi) p))
(setq o2 (polar pt4 ang p))
(if m;画排数为1的图形
(progn
(setq Clayer (getvar "clayer"))
(command "pline" pt3 "w" 0 "" pt4 "a" pt5 "l" pt6 "")
(setq en1 (entlast))
(command "pline" pt9 "w" 0 "" pt8 pt7 "a" pt6 "")
(setq en2 (entlast))
(command "pline" pt9 "w" 0 "" pt10 pt11 pt12 "")
(command "chamfer" "d" 1 "")
(command "chamfer" "p" (entlast))
(command "chamfer" "d" 0 "")
(command "_.layer""make" "中心线" "L"
"ACAD_ISO10W100" "" "Color"
6 "" ""
)
(command "line" pt1 pt2 "") ;中心线
(command "line" pt3 pt8 "") ;节线
(setvar "clayer" Clayer)
(setq en3 (entlast))
(command "line" pt3 (polar pt3 (+ ang (* pi 1.5)) df) "")
(command "_.mirror" en1 en2 en3 "" pt1 pt2 "n")
(setq pt3 (distance pt3 pt2))
(setq pt3 (mapcar '+ (list pt3 0 0) pt2))
;返回点用于画正视图中心
)
)
)
(if (> m 1)(command "_.copy" en1 en2 en3 "" (list 0 0 0) (list pt 0 0)))
pt3
)
**** Hidden Message ***** 我也来看看！ 我也来看看，黄兄也很强大呀 虽然用不上，我也来看看 瞧瞧黄先生的隐藏内容 不错嘛，，，支持一个 瞧瞧黄先生的隐藏内容 我来学习。。。。。。 看一看隐藏的东西 黄老板很强大