[LISP函数]：齿轮函数源代码

olivefei

(defun c:jkxcl1()
(if( < (seq index (load_dialog "chilun" ))0) (exit))
(if(not(new_dialog "chilun" index))(exit))
(action_tile "clear" "(clear)")
(action_tile "start" "(start)")
(start_dialog)
(unload_dialog index_value)
)
(defun clear()
(set_tile "getreal" " ")
(set_tile "getint" " ")
(set_tile "getreal1" " ")
(set_tile "getreal2" " ")
(set_tile "getreal3" " ")
(set_tile "getreal4" " ")
(set_tile "getreal5" " ")
(set_tile "error" " ")
(mode_tile "data" 8)
)
(defun start()
(setq m (get_tile "getreal"))
(setq m (read m))
(setq z (get_tile "getint"))
(setq z (read z))
(setq h (get_tile "getreal1"))
(setq h (read h))
(setq zj (get_tile "getreal2"))
(setq zj (read zj))
(setq lf (get_tile "getreal3"))
(setq lf (read lf))
(if (>h lf )(progn
(setq gr (get_tile "getreal4"))
(setq gr (read gr))
(setq yr (get_tile "getreal5"))
(setq yr (read yr))
(setq s(/ (- h lf) 2))                            ;凹入深度
    (setq l(- h s))
    )
  )
  (setq rf(/ (* (- z 2.5) m) 2))
  (setq rj(/ (* m z 0.939693) 2))
  (setq r(/ (* z m) 2))
  (setq ra(/ (* (+ z 2) m) 2))
  (setq tt(* m pi))
  (setq pj(/ 36.0 z))
  (setq a(/ (* 1.25 m) (cos (* 20 (/ pi 180)))))
  (setq pt0(list 200.0 30.0 0.0))
  (setq pt1(polar pt0 0 (/ tt 4)))
  (setq pt2(polar pt0 pi (/ tt 4)))
  (setq pt3(polar pt1 (* 110 (/ pi 180)) a))
  (setq pt5(polar pt1 (* -70 (/ pi 180)) a))
  (setq pt4(polar pt2 (* 70  (/ pi 180)) a))
  (setq pt6(polar pt2 (* 250 (/ pi 180)) a))
  (setq pt7(polar pt6 (* -90 (/ pi 180)) 2))
  (command "layer" "m" "l1" "c" 1 "" "")
  (command "layer" "m" "l2" "c" 2 "" "")
  (command "layer" "m" "l3" "c" 252 "" "")
  (command "layer" "s" "l3" "")
  (command "pline" pt7 pt6 pt4 pt3 pt5)
  (setq i 1)
  (while (<= i 7)
    (setq pt6(polar pt6 0 tt))
    (setq pt4(polar pt4 0 tt))
    (setq pt3(polar pt3 0 tt))
    (setq pt5(polar pt5 0 tt))
    (command pt6 pt4 pt3 pt5)
    (setq i(+ i 1))
  )
  (setq pt8(polar pt5 (* -90 (/ pi 180)) 2))
  (command pt8 "c")
  (setq pt(polar pt0 (* 180 (/ pi 180)) (* 4 tt)))
  (command "move" "l" "" pt0 pt)
  (setq e0(entlast))                     ;完成齿条
  (command "layer" "s" "l1" "")
  (setq p0(polar pt0 (* 90 (/ pi 180)) r))
  (command "circle" p0 ra)
  (command "region" "l" "")
  (setq e10(entlast))                    ;完成齿轮毛坯圆
  (command "layer" "s" "l2" "")
  (setq j 1)
  (while (<= j z)
    (setq i 1)
    (while (<= i 10)               
      (command "rotate" e10 "" p0 pj)    ;旋转毛胚
      (setq yd(* r pj (/ pi 180) i))           
      (setq pt(polar pt0 0 yd))
      (command "copy" e0 "" Pt0 pt)      ;移动齿条
      (command "region" "l" "")
      (setq e1(entlast))
      (command "subtract" e10 "" e1 "")
      (setq i(+ i 1))
    )

    (setq j(+ j 1))
  )
  (command "layer" "s" "l1" "")
  (command "extrude" e10 "" h 0)         ;拉伸齿轮
  (setq e5(entlast))
  (command "erase" e0 "")
  
  (if (> h lf)(progn
    (command "circle" p0 yr)               ;创建右侧轮缘轮廓
    (setq e1(entlast))
    (command "extrude" e1 "" s 5)
    (setq e1(entlast))
    (command "circle" p0 gr)               ;创建右侧轮毂轮廓
    (setq e2(entlast))
    (command "extrude" e2 "" s -5)
    (setq e2(entlast))
    (command "subtract" e1 "" e2 "")
    (setq pt(list (car p0) (car (cdr p0)) h))
    (setq s(- 0 s))
    (command "circle" pt yr)               ;创建左侧轮缘轮廓
    (setq e3(entlast))
    (command "extrude" e3 "" s 10)
    (setq e3(entlast))
    (command "circle" pt gr)               ;创建左侧轮毂轮廓
    (setq e4(entlast))
    (command "extrude" e4 "" s -10)
    (setq e4(entlast))
    (command "subtract" e3 "" e4 "")
    (command "cylinder" p0 (/ zj 2) h)
    (setq e4(entlast))
    (command "subtract" e5 "" e1 e3 e4 "")
    )
    (progn (command "cylinder" p0 (/ zj 2) h)
      (setq e4(entlast))
      (command "subtract" e5 "" e4 "")
    )
  )
)




dcl 源程序


chilun:dialog
{label="渐开线齿轮"
:edit_box
{label="输入模数"
key="getreal"
value=""}
:edit_box
{label="输入齿数"
key="getint"
value=""}
:edit_box
{label="输入齿轮宽度"
key="getreal1"
value=""}
:edit_box
{label="输入齿轮轴颈"
key="getreal2"
value=""}
:edit_box
{label:"输入轮辐厚度（无轮辐结构时输入齿轮厚度）"
key="getreal3"
value=""}
:edit_box
{label:"输入轮毂端面半径"
key="getreal4"
value=""}
:edit_box
{label:"输入轮员端面半径"
key="getreal5"
value=""}
:row{
:button{
key="start"
label="开始"
}
:button{
key="clear"
label="清除"
}
:ok=button{
label="退出"
}}
errtile}