画链轮.lsp

自贡黄明儒

;;其它论坛有画链轮的程序，明经论坛也应该有
;;曾经有一段时间，我常画链轮，须不复杂，每次计算确很繁琐,所以关注它
;;希望改编后的程序更完善

1. ;;画链轮 自贡黄明儒 2012.12.07
   
2. (defun c:Draw_Chain (/ B1 CMDECHO1 DR H M NO OSMODE1 P P0 PT Z)
   
3.   (setq cmdecho1 (getvar "cmdecho"))
   
4.   (setq osmode1 (getvar "osmode"))
   
5.   (setvar "cmdecho" 0)
   
6.   (setvar "osmode" 0)
   
7.   (initget "08A 10A 12A 16A 20A 24A 28A 32A 40A 48A")
   
8.   (setq
   
9.     no
   
10.      (getkword
    
11.        "\n 请输入链号[08A/10A/12A/16A/20A/24A/28A/32A/40A/48A]<08A>:"
    
12.      )
    
13.   )
    
14.   (if (= no nil)
    
15.     (setq no "08A")
    
16.   )
    
17.   (if (setq z (getint "\n 请输入齿数<12>:"))
    
18.     nil
    
19.     (setq z 12)
    
20.   )
    
21.   (if (setq m (getint "\n 请输入排数<1>:"))
    
22.     nil
    
23.     (setq m 1)
    
24.   )
    
25.   (setq no (strcase no))
    
26.   (cond        ((= no "08A")
    
27.          (setq p 12.7)
    
28.          (setq dr 7.95)
    
29.          (setq pt 14.38)
    
30.          (setq b1 7.85)
    
31.          (setq h 12.07)
    
32.         )
    
33.         ((= no "10A")
    
34.          (setq p 15.875)
    
35.          (setq dr 10.16)
    
36.          (setq pt 18.11)
    
37.          (setq b1 9.4)
    
38.          (setq h 15.09)
    
39.         )
    
40.         ((= no "12A")
    
41.          (setq p 19.05)
    
42.          (setq dr 11.91)
    
43.          (setq pt 22.78)
    
44.          (setq b1 12.57)
    
45.          (setq h 18.08)
    
46.         )
    
47.         ((= no "16A")
    
48.          (setq p 25.4)
    
49.          (setq dr 15.88)
    
50.          (setq pt 29.29)
    
51.          (setq b1 15.75)
    
52.          (setq h 24.13)
    
53.         )
    
54.         ((= no "20A")
    
55.          (setq p 31.75)
    
56.          (setq dr 19.05)
    
57.          (setq pt 35.76)
    
58.          (setq b1 18.9)
    
59.          (setq h 30.18)
    
60.         )
    
61.         ((= no "24A")
    
62.          (setq p 38.1)
    
63.          (setq dr 22.23)
    
64.          (setq pt 45.44)
    
65.          (setq b1 25.22)
    
66.          (setq h 36.2)
    
67.         )
    
68.         ((= no "28A")
    
69.          (setq p 44.45)
    
70.          (setq dr 25.4)
    
71.          (setq pt 48.87)
    
72.          (setq b1 25.22)
    
73.          (setq h 42.24)
    
74.         )
    
75.         ((= no "32A")
    
76.          (setq p 50.8)
    
77.          (setq dr 28.585)
    
78.          (setq pt 58.55)
    
79.          (setq b1 31.55)
    
80.          (setq h 48.26)
    
81.         )
    
82.         ((= no "40A")
    
83.          (setq p 63.5)
    
84.          (setq dr 39.68)
    
85.          (setq pt 71.55)
    
86.          (setq b1 37.85)
    
87.          (setq h 60.33)
    
88.         )
    
89.         (t
    
90.          (setq p 76.2)
    
91.          (setq dr 47.63)
    
92.          (setq pt 87.83)
    
93.          (setq b1 47.35)
    
94.          (setq h 72.39)
    
95.         )
    
96.   )
    
97.   (if (setq p0 (Draw_Chain1 p dr pt b1 z m)) ;用于正视图中心点
    
98.     (Draw_Chain2 p0 p dr pt b1 z h)
    
99.   )
    
100.   (setvar "cmdecho" cmdecho1)
     
101.   (setvar "osmode" osmode1)
     
102.   (princ)
     
103. )
     
104. (defun Draw_Chain1 (p         dr   pt   b1        z    m          /    ANG  ANG1 BA
     
105.                     BF1         BFM  CLAYER        D    DA          DF   DG   EN1         EN2
     
106.                     EN3         H    L           M1        M2   O1          O2   PT1  PT10 PT11
     
107.                     PT12 PT2  PT3  PT4        PT5  PT6  PT7  PT8  PT9         RA
     
108.                     X1         X2   XB
     
109.                    )
     
110.   (cond        ((= m 1) (setq bf1 (* 0.93 b1)))
     
111.         ((= m 2) (setq bf1 (* 0.91 b1)))
     
112.         ((= m 3) (setq bf1 (* 0.91 b1)))
     
113.         ((>= m 4) (setq bf1 (* 0.88 b1)))
     
114.         (t (setq bf1 (* 0.93 b1)))
     
115.   )
     
116.   (setq ba (* p 0.125))
     
117.   (setq h (* p 0.5))
     
118.   (setq ra (* p 0.04))
     
119.   (setq bfm (+ bf1 (* pt (- m 1))))
     
120.   (setq ang1 (/ pi z))                        ;ang1为180/z的弧度值
     
121.   (setq d (/ p (sin ang1)))
     
122.   (setq da (fix (- (+ d (* p 1.25)) dr)))
     
123.   (setq df (- d dr))
     
124.   (setq dg (fix (- (* p (/ (cos ang1) (sin ang1))) (* h 1.04) 0.76 dr)))
     
125.   (and (setq pt1 (getpoint "\n 请输入起点:"))
     
126.        (setq pt2 (getpoint pt1 "\n 请输入链轮宽度:"))
     
127.        (setq l (distance pt1 pt2))
     
128.        (setq ang (angle pt1 pt2))
     
129.        (setq pt3 (polar pt1 (+ (* pi 0.5) ang) (/ df 2)))
     
130.        (setq pt4 (polar pt3 (+ (* pi 0.5) ang) (- (/ (- da df) 2) h)))
     
131.        (setq x1 (polar pt1 (+ ang (* 0.5 pi)) (/ da 2)))
     
132.        (setq x2 (polar x1 ang bf1))
     
133.        (setq xb (polar pt1 ang bf1))
     
134.        (setq m1 (polar pt1 (+ ang pi) 2))
     
135.        (setq m2 (polar xb ang 2))
     
136.        (setq pt5 (polar x1 ang ba))
     
137.        (setq pt6 (polar pt5 ang (- bf1 (* ba 2))))
     
138.        (setq pt7 (polar pt4 ang bf1))
     
139.        (setq pt8 (polar pt3 ang bf1))
     
140.        (setq pt9 (polar xb (+ ang (* pi 0.5)) (/ dg 2)))
     
141.        (setq pt10 (polar pt2 (+ ang (* 0.5 pi)) (/ dg 2)))
     
142.        (setq pt11 (polar pt2 (+ ang (* 1.5 pi)) (/ dg 2)))
     
143.        (setq pt12 (polar xb (+ ang (* 1.5 pi)) (/ dg 2)))
     
144.        (setq o1 (polar pt7 (+ ang pi) p))
     
145.        (setq o2 (polar pt4 ang p))
     
146.        (if m;画排数为1的图形
     
147.          (progn
     
148.            (setq Clayer (getvar "clayer"))
     
149.            (command "pline" pt3 "w" 0 "" pt4 "a" pt5 "l" pt6 "")
     
150.            (setq en1 (entlast))
     
151.            (command "pline" pt9 "w" 0 "" pt8 pt7 "a" pt6 "")
     
152.            (setq en2 (entlast))
     
153.            (command "pline" pt9 "w" 0 "" pt10 pt11 pt12 "")
     
154.            (command "chamfer" "d" 1 "")
     
155.            (command "chamfer" "p" (entlast))
     
156.            (command "chamfer" "d" 0 "")
     
157.            (command "_.layer"  "make"          "中心线"   "L"
     
158.                     "ACAD_ISO10W100"          ""             "Color"
     
159.                     6               ""          ""
     
160.                    )
     
161.            (command "line" pt1 pt2 "")        ;中心线
     
162.            (command "line" pt3 pt8 "")        ;节线
     
163.            (setvar "clayer" Clayer)
     
164.            (setq en3 (entlast))
     
165.            (command "line" pt3 (polar pt3 (+ ang (* pi 1.5)) df) "")
     
166.            (command "_.mirror" en1 en2 en3 "" pt1 pt2 "n")
     
167.            (setq pt3 (distance pt3 pt2))
     
168.            (setq pt3 (mapcar '+ (list pt3 0 0) pt2))
     
169.                                         ;返回点用于画正视图中心
     
170.          )         
     
171.        )
     
172.   )
     
173.   (if (> m 1)(command "_.copy" en1 en2 en3 "" (list 0 0 0) (list pt 0 0)))
     
174.   pt3
     
175. )
     

;;画链轮 自贡黄明儒 2012.12.07<br /> (defun c:Draw_Chain (/ B1 CMDECHO1 DR H M NO OSMODE1 P P0 PT Z)<br />   (setq cmdecho1 (getvar "cmdecho"))<br />   (setq osmode1 (getvar "osmode"))<br />   (setvar "cmdecho" 0)<br />   (setvar "osmode" 0)<br />   (initget "08A 10A 12A 16A 20A 24A 28A 32A 40A 48A")<br />   (setq<br />     no<br />      (getkword<br />        "\n 请输入链号[08A/10A/12A/16A/20A/24A/28A/32A/40A/48A]<08A>:"<br />      )<br />   )<br />   (if (= no nil)<br />     (setq no "08A")<br />   )<br />   (if (setq z (getint "\n 请输入齿数<12>:"))<br />     nil<br />     (setq z 12)<br />   )<br />   (if (setq m (getint "\n 请输入排数<1>:"))<br />     nil<br />     (setq m 1)<br />   )<br />   (setq no (strcase no))<br />   (cond        ((= no "08A")<br />          (setq p 12.7)<br />          (setq dr 7.95)<br />          (setq pt 14.38)<br />          (setq b1 7.85)<br />          (setq h 12.07)<br />         )<br />         ((= no "10A")<br />          (setq p 15.875)<br />          (setq dr 10.16)<br />          (setq pt 18.11)<br />          (setq b1 9.4)<br />          (setq h 15.09)<br />         )<br />         ((= no "12A")<br />          (setq p 19.05)<br />          (setq dr 11.91)<br />          (setq pt 22.78)<br />          (setq b1 12.57)<br />          (setq h 18.08)<br />         )<br />         ((= no "16A")<br />          (setq p 25.4)<br />          (setq dr 15.88)<br />          (setq pt 29.29)<br />          (setq b1 15.75)<br />          (setq h 24.13)<br />         )<br />         ((= no "20A")<br />          (setq p 31.75)<br />          (setq dr 19.05)<br />          (setq pt 35.76)<br />          (setq b1 18.9)<br />          (setq h 30.18)<br />         )<br />         ((= no "24A")<br />          (setq p 38.1)<br />          (setq dr 22.23)<br />          (setq pt 45.44)<br />          (setq b1 25.22)<br />          (setq h 36.2)<br />         )<br />         ((= no "28A")<br />          (setq p 44.45)<br />          (setq dr 25.4)<br />          (setq pt 48.87)<br />          (setq b1 25.22)<br />          (setq h 42.24)<br />         )<br />         ((= no "32A")<br />          (setq p 50.8)<br />          (setq dr 28.585)<br />          (setq pt 58.55)<br />          (setq b1 31.55)<br />          (setq h 48.26)<br />         )<br />         ((= no "40A")<br />          (setq p 63.5)<br />          (setq dr 39.68)<br />          (setq pt 71.55)<br />          (setq b1 37.85)<br />          (setq h 60.33)<br />         )<br />         (t<br />          (setq p 76.2)<br />          (setq dr 47.63)<br />          (setq pt 87.83)<br />          (setq b1 47.35)<br />          (setq h 72.39)<br />         )<br />   )<br />   (if (setq p0 (Draw_Chain1 p dr pt b1 z m)) ;用于正视图中心点<br />     (Draw_Chain2 p0 p dr pt b1 z h)<br />   )<br />   (setvar "cmdecho" cmdecho1)<br />   (setvar "osmode" osmode1)<br />   (princ)<br /> )<br /> (defun Draw_Chain1 (p         dr   pt   b1        z    m          /    ANG  ANG1 BA<br />                     BF1         BFM  CLAYER        D    DA          DF   DG   EN1         EN2<br />                     EN3         H    L           M1        M2   O1          O2   PT1  PT10 PT11<br />                     PT12 PT2  PT3  PT4        PT5  PT6  PT7  PT8  PT9         RA<br />                     X1         X2   XB<br />                    )<br />   (cond        ((= m 1) (setq bf1 (* 0.93 b1)))<br />         ((= m 2) (setq bf1 (* 0.91 b1)))<br />         ((= m 3) (setq bf1 (* 0.91 b1)))<br />         ((>= m 4) (setq bf1 (* 0.88 b1)))<br />         (t (setq bf1 (* 0.93 b1)))<br />   )<br />   (setq ba (* p 0.125))<br />   (setq h (* p 0.5))<br />   (setq ra (* p 0.04))<br />   (setq bfm (+ bf1 (* pt (- m 1))))<br />   (setq ang1 (/ pi z))                        ;ang1为180/z的弧度值<br />   (setq d (/ p (sin ang1)))<br />   (setq da (fix (- (+ d (* p 1.25)) dr)))<br />   (setq df (- d dr))<br />   (setq dg (fix (- (* p (/ (cos ang1) (sin ang1))) (* h 1.04) 0.76 dr)))<br />   (and (setq pt1 (getpoint "\n 请输入起点:"))<br />        (setq pt2 (getpoint pt1 "\n 请输入链轮宽度:"))<br />        (setq l (distance pt1 pt2))<br />        (setq ang (angle pt1 pt2))<br />        (setq pt3 (polar pt1 (+ (* pi 0.5) ang) (/ df 2)))<br />        (setq pt4 (polar pt3 (+ (* pi 0.5) ang) (- (/ (- da df) 2) h)))<br />        (setq x1 (polar pt1 (+ ang (* 0.5 pi)) (/ da 2)))<br />        (setq x2 (polar x1 ang bf1))<br />        (setq xb (polar pt1 ang bf1))<br />        (setq m1 (polar pt1 (+ ang pi) 2))<br />        (setq m2 (polar xb ang 2))<br />        (setq pt5 (polar x1 ang ba))<br />        (setq pt6 (polar pt5 ang (- bf1 (* ba 2))))<br />        (setq pt7 (polar pt4 ang bf1))<br />        (setq pt8 (polar pt3 ang bf1))<br />        (setq pt9 (polar xb (+ ang (* pi 0.5)) (/ dg 2)))<br />        (setq pt10 (polar pt2 (+ ang (* 0.5 pi)) (/ dg 2)))<br />        (setq pt11 (polar pt2 (+ ang (* 1.5 pi)) (/ dg 2)))<br />        (setq pt12 (polar xb (+ ang (* 1.5 pi)) (/ dg 2)))<br />        (setq o1 (polar pt7 (+ ang pi) p))<br />        (setq o2 (polar pt4 ang p))<br />        (if m;画排数为1的图形<br />          (progn<br />            (setq Clayer (getvar "clayer"))<br />            (command "pline" pt3 "w" 0 "" pt4 "a" pt5 "l" pt6 "")<br />            (setq en1 (entlast))<br />            (command "pline" pt9 "w" 0 "" pt8 pt7 "a" pt6 "")<br />            (setq en2 (entlast))<br />            (command "pline" pt9 "w" 0 "" pt10 pt11 pt12 "")<br />            (command "chamfer" "d" 1 "")<br />            (command "chamfer" "p" (entlast))<br />            (command "chamfer" "d" 0 "")<br />            (command "_.layer"  "make"          "中心线"   "L"<br />                     "ACAD_ISO10W100"          ""             "Color"<br />                     6               ""          ""<br />                    )<br />            (command "line" pt1 pt2 "")        ;中心线<br />            (command "line" pt3 pt8 "")        ;节线<br />            (setvar "clayer" Clayer)<br />            (setq en3 (entlast))<br />            (command "line" pt3 (polar pt3 (+ ang (* pi 1.5)) df) "")<br />            (command "_.mirror" en1 en2 en3 "" pt1 pt2 "n")<br />            (setq pt3 (distance pt3 pt2))<br />            (setq pt3 (mapcar '+ (list pt3 0 0) pt2))<br />                                         ;返回点用于画正视图中心<br />          )         <br />        )<br />   )<br />   (if (> m 1)(command "_.copy" en1 en2 en3 "" (list 0 0 0) (list pt 0 0)))<br />   pt3<br /> )<br />

(defun Draw_Chain2 (c1         p    dr   pt        b1   z          h    /    A         ANG1
                    ANGDD     ANGM1        ANGM2          ANGM3            ANGM4
                    AREA1     AREA2        C2   CLAYER    CR1  CR2         D
                    DA         DF   DG   H1        H2   L1          L2   PA1  PA2         PA3
                    PA4         PA5  PA6  PA7        RE   RI          S1   S2   U1         U2
                    V1         V2   W1
                   )
  (setq ang1 (/ pi z))                        ;ang1为180/z的弧度值
  ;;以下进行链轮参数计算
  (setq angdd (/ (* 2 pi) z))                ;每个齿对应的角度
  (setq re (* 0.12 dr (+ z 2)))                ;齿面圆弧半径
  (setq ri (* dr 0.505))                ;齿沟圆半径
  (setq a (- (* (/ pi 180) 140) (/ (* pi 0.5) z))) ;齿沟角
  (setq d (/ p (sin (/ pi z))))                ;分度圆直径
  (setq        da (fix        (/ (+ (- (+ d (* p (- 1 (/ 1.6 z)))) dr)
                      (- (+ d (* p 1.25)) dr)
                   )
                   2
                )
           )
  )                                        ;齿顶圆直径
  (setq df (- d dr))                        ;齿根圆直径
  (setq dg (fix (- (* p (/ (cos ang1) (sin ang1))) (* h 1.04) 0.76 dr)))

                                        ;齿侧凸缘直径
  ;;链轮中心点
  (setq c2 (polar c1 (* -1 (* angdd 0.5)) (* d 0.5)))
  (setq cr1 (polar c2 (- (+ pi (* a 0.5)) (* angdd 0.5)) (+ re ri)))
  (setq cr2 (polar c2 (- (- pi (* a 0.5)) (* angdd 0.5)) (+ re ri)))
  ;;求三角1角度angm1
  (setq u1 (* d 0.5))
  (setq v1 (+ ri re))
  (setq w1 (distance c1 cr1))
  (setq s1 (* (+ u1 v1 w1) 0.5))
  (setq area1 (sqrt (* s1 (- s1 u1) (- s1 v1) (- s1 w1))))
  (setq h1 (/ (* 2 area1) w1))
  (setq l1 (sqrt (- (* u1 u1) (* h1 h1))))
  (setq angm1 (atan h1 l1))
  ;;求三角2角度angm2
  (setq u2 (* da 0.5))
  (setq v2 re)
  (setq s2 (* 0.5 (+ u2 v2 w1)))
  (setq area2 (sqrt (* s2 (- s2 u2) (- s2 v2) (- s2 w1))))
  (setq h2 (/ (* 2 area2) w1))
  (setq l2 (sqrt (- (* u2 u2) (* h2 h2))))
  (setq angm2 (atan h2 l2))
  ;;求齿顶圆弧对应的角度angm4
  (setq angm3 (- angm1 angm2))
  (setq angm4 (- angdd (* angm3 2)))
  ;;继续进行绘图点的定义与赋值
  (setq pa1 (polar c1 (* -1 (+ (* angdd 0.5) angm3)) (* da 0.5)))
  (setq pa2 (polar c2 (- (+ pi (* 0.5 a)) (* angdd 0.5)) ri))
  (setq pa3 (polar c1 (* -1 (* angdd 0.5)) (- (* d 0.5) ri)))
  (setq pa4 (polar c2 (- (- pi (* a 0.5)) (* angdd 0.5)) ri))
  (setq pa5 (polar c1 (* -1 angm4 0.5) (* da 0.5)))
  (setq pa6 (polar c1 0 (* da 0.5)))
  (setq pa7 (polar c1 (* angm4 0.5) (* da 0.5)))
  ;;绘制轮齿
  (command "_.pline" pa1 "w" 0 "" "a" "ce" cr1 pa2 "s" pa3 pa4 pa5 "s"
           pa6 pa7 "")
  (command "_.array" (entlast) "" "p" c1 z "" "")
  (setq Clayer (getvar "clayer"))
  (command "_.layer"  "make"         "中心线"   "L"               "ACAD_ISO10W100"
           ""              "Color"         6            ""               ""
          )
  (command "_.circle" c1 c2)
  (setvar "clayer" Clayer)
)

Q1241274614

我也来看看！

haoryh

我也来看看，黄兄也很强大呀

sqqr

虽然用不上，我也来看看

USER2128

瞧瞧黄先生的隐藏内容

xiabin68

不错嘛，，，支持一个

zhengchuan

瞧瞧黄先生的隐藏内容

shengyulon

我来学习。。。。。。

Michael527

看一看隐藏的东西

1993063

黄老板很强大