iCAx开思网

标题: 【分享】AUTOCAD-R2000-lisp压缩弹簧绘制程序 [打印本页]

作者: cch 时间: 2003-1-24 10:38
标题: 【分享】AUTOCAD-R2000-lisp压缩弹簧绘制程序
;;;绘制压缩弹簧的lsp
;;;请载入后键入'spring'执行
(defun c:spring()
    (setvar "CMDECHO" 0)
    (setq pt (getpoint "\n请输入基点:"))
    (setq dd (getreal "\n请输入弹簧钢丝直径:"))
    (setq rr (/ (getreal "\n请输入弹簧直径:") 2))
    (setq tt (getreal "\n请输入弹簧节距:"))
    (setq hh (getreal "\n请输入弹簧长度:"))
    (setq nn (getint "\n请输入圆弧拟合数:"))
    (setq delta (/ (* 2.0 pi) nn))
    (setq li (/ (- hh (* 2 dd)) tt))  ;有效圈数
    (setq ni (+ li 2)) ;总圈数
    (setq mm (* ni nn))
    ;;;修正AUTOCAD数据误差
      (setq mm (fix (* 10 mm)))
      (setq xy (rem mm 10))
      (setq mm (fix (/ mm 10))) ;拟合点数
      (if (>= xy 5)
         (setq mm (+ 1 mm))
      )
      (if (<= xy -5)
         (setq mm (- mm 1))
      )
    (setq ang 0)
    (setq hi 0)
    (setq oo 0)
    (command "UCS" "o" pt)
    (command "3dpoly" (list rr 0 0 ))
    (while (< oo mm)
        (setq juli (/ tt nn))
        (if (< oo nn)
   (setq juli (/ dd nn))
  )
        (if (> oo (* (- ni 1) nn))
   (setq juli (/ dd nn))
  )
        (setq ang (+ delta ang))
        (setq pt2 (list (* rr (cos ang))(* rr (sin ang))(+ hi juli)))
        (setq hi (+ juli hi))
        (setq oo (+ oo 1))
        (command pt2)
    )
    (command "")
    (setq se (entlast))
    (command "ucs" "x" "90")
    (setq pt (list rr 0))
    (setq dr (/ dd 2))
    (command "circle" pt dr "")
    (setq si (entlast))
    (command "extrude" si "" "p" se)
    (setq ss (entlast))
    (command "erase" se "")
    (setq pt1 (list rr 0 0))
    (setq pt2 (list rr hh 0))
    (setq pt3 (list 0 1 0))
    (command "slice" ss "" "zx" pt1 pt3 )
    (command "slice" ss "" "zx" pt2 pt3 )
    (command "ucs" "")
    (defun c:ce();函数名为ce
    (setq cir (entsel "\n请选择圆:"))
    (setq qq (entget (car cir)))
    (setq oldosmode (getvar "osmode"))
    (setvar "osmode" 0)
    (if (or (equal (assoc 0 qq) '(0 . "CIRCLE")) (equal (assoc 0 qq) '(0 . "ARC")))
       (progn
         (setq pto (cdr (assoc 10 qq)))
　　    (setq r (cdr (assoc 40 qq)));确定半径)
     　　(setq pl (list (- (car pto) 3 r) (cadr pto)))
     　　(setq pr (list (+ (car pto) 3 r) (cadr pto)))
     　　(setq pt (list (car pto) (+ (cadr pto) 3 r)))
     　　(setq pb (list (car pto) (- (cadr pto) 3 r)))
         (command "layer" "N" "center" "C" "green" "center" "L" "center" "center" "S" "center" "");设置新的点划线层
     　　(command "line" pr pl "")
     　　(command "line" pt pb "");画出点划线
     　　(command "layer" "S" "0" "")
        )
        (progn
   (prompt "\n对象不是圆弧!")
  )
     )
     (setvar "osmode" oldosmode)
     (princ)
)
(prompt "\n添加圆或圆弧的中心线,请键入'ce'启动!")
(prompt "\n压缩弹簧绘制程序")
(prompt "请载入后键入'spring'执行")

作者: Jacky Wang 时间: 2003-1-24 10:44
好東東！頂！

欢迎光临 iCAx开思网 (https://www.icax.org/)