3DTANHUANG三维弹簧.lsp
上传用户:sd555111
上传日期:2014-05-17
资源大小:31k
文件大小:2k
源码类别:

CAD

开发平台:

MathCAD

  1. (defun c:3dtanhuang(/)
  2.   (setq p1(getpoint "请指定螺旋线基点:"))
  3.   (setq r(getreal "请输入弹簧平均半径:"))
  4.   (setq d0(getreal "请输入弹簧丝直径:"))
  5.   (setq disp(getreal "请输入弹簧节距:"))
  6.   (setq n0(getint "请输入弹簧工作圈数:"))
  7.   (setq n(getint "请输入每圈细化段数(16/20/24/28/32/36/50/100):"))
  8.   (setq n1(* 1.25 n))                   ;支撑圈细化段数
  9.   (setq n1(fix n1))
  10.   (setq n2(* n0 n))                     ;工作圈细化段数
  11.   (setq delta(/ (* 2.0 pi) n))          ;单位转角
  12.   (setq j(/ disp n))                    ;工作圈轴向位移量
  13.   (setq j0(/ d0 n))                     ;支撑圈轴向位移量
  14.   (setq bb(caddr p1))
  15.   (setq ang 0)
  16.   (setq jj 0)
  17.   (command "ucs" "o" p1)
  18.   (setq pt1(list r 0 0))
  19.   (command "3dpoly" pt1)
  20.   (repeat n1                            ;绘制下支撑圈
  21.     (setq jj(+ jj 1))
  22.     (setq ang(+ delta ang))
  23.     (setq pt(list (* r (cos ang)) (* r (sin ang)) (* j0 jj)))
  24.     (command pt)
  25.   )
  26.   (setq p2(list 0 0 (* j0 jj)))
  27.   (setq g1(* j0 jj))                    ;下支撑圈高度
  28.   (setq jj 0)
  29.   (repeat n2                            ;绘制工作圈
  30.     (setq jj(+ jj 1))
  31.     (setq ang(+ delta ang))
  32.     (setq pt(list (* r (cos ang)) (* r (sin ang)) (+ g1 (* j jj))))
  33.     (command pt)
  34.   )
  35.   (setq p3(list 0 0 (* j jj)))
  36.   (setq g2(* j jj))                     ;工作圈高度
  37.   (setq jj 0)
  38.   (repeat n1                            ;绘制上支撑圈
  39.     (setq jj(+ jj 1))
  40.     (setq ang(+ delta ang))
  41.     (setq pt(list (* r (cos ang)) (* r (sin ang)) (+ g1 g2 (* j0 jj))))
  42.     (command pt)
  43.   )
  44.   (setq g3(* j0 jj))                    ;上支撑圈高度
  45.   (command "")
  46.   (setq e1(entlast))
  47.   (command "ucs" "x" "")                ;拉伸弹簧
  48.   (command "circle" pt1 (/ d0 2))
  49.   (setq e2(entlast))
  50.   (command "extrude" e2 "" "p" e1)
  51.   (setq e3(entlast))
  52.   (setq pt2(list r (/ d0 4) 0))         ;磨平
  53.   (setq py(+ g1 g2 g3 (- 0 (/ d0 4))))
  54.   (setq pt3(list (- 0 r) py 0))
  55.   (command "slice" e3 "" "zx" pt2 pt3)
  56.   (command "slice" e3 "" "zx" pt3 pt2)
  57.   (command "ucs" "w")
  58.   
  59. )