[LISP程序]：在CAD中画弹簧

lijiahao

求助：
有没有用LISP编写关于在CAD中画弹簧的小程序，
中文的。
知道的贴过来……
谢谢！

phoenixdjq

(defun c:luoxc (/)
     (setq bl (getpoint "请指定螺旋线基点: "))
     (setq rl (getreal "请指定初始螺旋线半径: "))
     (setq disp (getreal "请输入螺旋线节距: "))
     (setq angtg (getreal "请输入螺旋线锥形角度: "))
     (setq m (getint "请输入螺旋线圈数: "))
     (setq n (getint "请输入每圈细化段数: "))
     (setq delta (/ (* 2.0 pi) n))
     (setq j (/ disp n))
     (setq bb (caddr bl))
     (setq tg (* (/ angtg 180) pi))
     (setq ang 0)
     (setq k 0)
     (command "ucs" "o" bl)
     (command "3dpoly" (list rl 0 0))
     (repeat (* m n)
  (setq k (+ k 1)); (setq ang (+ delta ang))
  (setq r (- rl (* (+ 0 (* j k)) (/ (sin tg) (cos tg)))))
  (setq pt2 (list (* r (cos ang)) (* r (sin ang)) (+ 0 (* j k))))
  (command pt2);
     )
     (command "")
)

声明:这个程序是我从网上下载的.非本人所作,下面的也是下载的

;========================================================================
(defun C:3DSPIRAL (/ olderr ocmd oblp nt bp hg vg sr lp)
   (setq olderr  *error*
         *error* myerror)
   (setq ocmd (getvar "cmdecho"))
   (setq oblp (getvar "blipmode"))
   (setvar "cmdecho" 0)
   (initget 1)                         ; bp must not be null
   (setq bp (getpoint "\nCenter point: "));起始圈圆心
   (initget 7)                         ; nt must not be zero, neg, or null
   (setq nt (getint "\nNumber of rotations: "));弹簧圈数
   (initget 7)                         ; sr must not be zero, neg, or null
   (setq sr (getdist bp "\nStarting radius: "));起始圈半径
   (initget 1)                         ; cf must not be zero, or null
   (setq hg (getdist "\nHorizontal growth per rotation: "));每圈的水平增量，为0时绘出的弹簧粗细均匀
   (initget 3)                         ; cf must not be zero, or null
   (setq vg (getdist "\nVertical growth per rotation: "));每圈的垂直增量，也就是相邻两个圈的距离
   (initget 6)                         ; lp must not be zero or neg
   (setq lp (getint "\nPoints per rotation <30>: "));每圈上设置多少个点，点越多越接近圆。默认值30
   (cond ((null lp) (setq lp 30)))
   (cspiral nt bp hg lp sr vg)
   (setvar "cmdecho" ocmd)
   (setvar "blipmode" oblp)
   (setq *error* olderr)               ; Restore old *error* handler
   (princ)
)
;==========================================================================
(defun myerror (s)                    ; If an error (such as CTRL-C) occurs
                                       ; while this command is active...
   (if (/= s "Function cancelled")
     (princ (strcat "\nError: " s))
   )
   (setvar "cmdecho" ocmd)             ; Restore saved modes
   (setvar "blipmode" oblp)
   (setq *error* olderr)               ; Restore old *error* handler
   (princ)
)
;======================================================================
(defun cspiral (ntimes bpoint hfac lppass strad vfac
                 / ang dist tp ainc dhinc dvinc circle dv)


   (setvar "blipmode" 0)               ; turn blipmode off
   (setvar "cmdecho" 0)                ; turn cmdecho off
   (setq circle (* 3.1415926535 2))
   (setq ainc (/ circle lppass))
   (setq dhinc (/ hfac lppass))
   (if vfac (setq dvinc (/ vfac lppass)))
   (setq ang 0.0)
   (if vfac
     (setq dist strad dv 0.0)
     (setq dist 0.0)
   )
   (if vfac
     (command "_3dpoly")               ; start spiral ...
     (command "_pline" bpoint)         ; start spiral from base point and...
   )
   (repeat ntimes
     (repeat lppass
       (setq tp (polar bpoint (setq ang (+ ang ainc))
                       (setq dist (+ dist dhinc))
                )
       )
       (if vfac
           (setq tp (list (car tp) (cadr tp) (+ dv (caddr tp)))
                 dv (+ dv dvinc)
           )
       )
       (command tp)                    ; continue to the next point...
     )
   )
   (command "")                        ; until done.
   (princ)
)

；；；；；；；；；；；；；；
(defun C:lw(/)
(setq r(getreal "小径的半径r1："))
(setq dr(getreal "大径的半径dr："))
(setq t(getreal "节距"))
(setq n(getint "每圈分段数"))
(setq nn(getint "圈数"))
(setq dfjd (/ 360.0 n)) ;等分角度
(setq delt (/ (* 2.0 pi) n )) ; 等分弧度
(setq j( / t n))
(setq bb(caddr b1))
(setq ang 0 jd 0 jj 0)
(setq osmode(getvar "osmode")) (SETVAR "OSMODE" 0) (setvar "cmdecho" 0)
(chx t (- dr r) )
(chr (list r 0 0 ) 0 )
(setq m1 (entlast))
(repeat nn
  (repeat n
        (setq jj(+ jj 1))
         (setq ang (+ delt ang) jd (+ dfjd jd) )
        (setq pt2(list (* r (cos ang))(* r (sin ang))(+ 0(* j jj))))
        (chr pt2 jd)
        (setq m2 (entlast) )
        (command "_rulesurf" m1 m2)
        (command "erase" m1 "")
        (setq m1 m2)
        
  )
(print)
)
(command "erase" m1 "")
(command "-purge" "b"  "ljcgq" "n") (SETVAR "OSMODE" osmode)
)

(defun chx( chk chg / p1 p2 p3 p4)  ;chx--齿形  chk齿宽 齿高 chg
    (command "ucs" "w" )
    (command "ucs" "x" "90" )
    (setq p1 (list 0 0 ) p2 (polar p1 (/ pi 2) (/ chk 2) )  p3 (polar p1 0 chg) p4  (polar p1 (/ pi -2) (/ chk 2) ))
    (command "pline" p1 p2 p3 p4  "c"  )
    (command "ucs" "w" )
    (command "-block" "ljcgq"  p1  (entlast) "")
)

(defun chr( pr ang / )  ;chr插入 pr--插入点 ang--角度
    (command "-insert" "ljcgq"  pr  "" "" ang )
    (command "_explode" (entlast) )
)

黄河之水

这个早有了,不过还是感谢你

tiegang2005

辛苦了不得谢谢

lijiahao

谢谢二楼的收藏……