多排链轮主视图程序

chamous

这是一个画链轮主视图的程序.

可以支持画N排链轮.

是前几天发的相关程序的改进版.

现在小弟的水平只支持命令行输入,大家多多包涵.

另外还请哪位大侠如果感性趣的话,帮小弟查一下为什么程序结构后会出现"未知命令WL"这样的信息.

(defun c:wl()
  (setvar "cmdecho" 0)
  (initget "08A 10A 12A 16A 20A 24A 28A 32A 40A 48A")
  (setq no (getkword "请输入链号08A,10A,12A,16A,20A,24A,28A,32A,40A或48A<08A>:"))
  (if (= no nil) (setq no "08A"))
  (setq z (getint "请输入齿数<12>:"))
  (if (null z) (setq z 12))
  (setq m (getint "请输入排数<1>:"))
  (if (null m) (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))
 ((= no "10A") (setq p 15.875) (setq dr 10.16) (setq pt 18.11) (setq b1 9.4))
 ((= no "12A") (setq p 19.05) (setq dr 11.91) (setq pt 22.78) (setq b1 12.57))
 ((= no "16A") (setq p 25.4) (setq dr 15.88) (setq pt 29.29) (setq b1 15.75))
 ((= no "20A") (setq p 31.75) (setq dr 19.05) (setq pt 35.76) (setq b1 18.9))
 ((= no "24A") (setq p 38.1) (setq dr 22.23) (setq pt 45.44) (setq b1 25.22))
 ((= no "28A") (setq p 44.45) (setq dr 25.4) (setq pt 48.87) (setq b1 25.22))
 ((= no "32A") (setq p 50.8) (setq dr 28.585) (setq pt 58.55) (setq b1 31.55))
 ((= no "40A") (setq p 63.5) (setq dr 39.68) (setq pt 71.55) (setq b1 37.85))
 ((= no "48A") (setq p 76.2) (setq dr 47.63) (setq pt 87.83) (setq b1 47.35))
 (t                         (setq dr 7.95) (setq pt 14.38) (setq b1 7.85))
  )
  (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)))
  (setq pt1 (getpoint "请输入起点:"))
  (setq pt2 (getpoint pt1 "请输入链轮宽度:"))
  (setq l (distance pt1 pt2))
  (setq ang (angle pt1 pt2))
  (setq os (getvar "osmode"))
  (setvar "osmode" 0)
  (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 xm (polar pt1 ang bfm))
  (setq m1 (polar pt1 (+ ang pi) 2))
  (setq m2 (polar xm 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 pt8-9 (polar pt1 (+ ang (* pi 0.5)) (/ dg 2)))
  (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)))
  (command "line" pt8-9 (polar pt8-9 (+ ang (* pi 1.5)) dg) "")
  (if (= m 1)
    (progn
      (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 "line" pt3 pt8 "")
      (setq en3 (entlast))
      (command "line" pt3 (polar pt3 (+ ang (* pi 1.5)) df) "")
      (command "mirror" en1 en2 en3 "" pt1 pt2 "n" "")
      (command "mline" "st" "standard" "s" d "j" "z" m1 m2 "")
      (command "change" (entlast) "" "p" "la" "中心线" "")
      )
  ;;;以下循环画轮齿
    (progn
    (repeat m
    (command "pline" pt8-9 pt3 "w" 0 "" pt4 "a" pt5 "l" pt6 "")
    (setq en1 (entlast))
    (command "pline" pt9 "w" 0 "" pt8 pt7 "a" pt6 "")
    (setq en2 (entlast))
    (command "line" pt3 pt8 "")
    (setq en3 (entlast))
    (command "mirror" en1 en2 en3 "" pt1 pt2 "n" "")
    ;;;重新赋值
    (setq pt8-9 (polar pt8-9 ang pt))
    (setq pt3 (polar pt3 ang pt))
    (setq pt4 (polar pt4 ang pt))
    (setq x1 (polar x1 ang pt))
    (setq x2 (polar x2 ang pt))
    (setq xb (polar xb ang pt))
    (setq pt5 (polar pt5 ang pt))
    (setq pt6 (polar pt6 ang pt))
    (setq pt7 (polar pt7 ang pt))
    (setq pt8 (polar pt8 ang pt))
    (setq pt9 (polar pt9 ang pt))
    )
  (setq pt9 (polar xm (+ ang (* pi 0.5)) (* dg 0.5)))
  (command "line" pt9 (polar pt9 (+ ang (* pi 1.5)) dg) "")
  ;;;以下循环画齿侧凸缘
  (setq pt8-9 (polar pt1 (+ ang (* pi 0.5)) (/ dg 2)))
  (setq xb (polar pt1 ang bf1))
  (setq pt9 (polar xb (+ ang (* pi 0.5)) (/ dg 2)))
  (setq pt8-9 (polar pt8-9 ang pt))
  (repeat (- m 1)
    (command "line" pt9 pt8-9 "")
    (command "mirror" (entlast) "" pt1 pt2 "n" "")
    ;;;重新赋值
    (setq pt9 (polar pt9 ang pt))
    (setq pt8-9 (polar pt8-9 ang pt))
  )
  )
  )
  (command "mline" "st" "standard" "s" d "j" "z" m1 m2 "")
  (command "change" (entlast) "" "p" "la" "中心线" "")
  (setvar "osmode" os)
  (princ)
  )