[LISP函数]：用ACAD画三维弹簧的lisp

D.Y.Zhu

用ACAD画三维弹簧的lisp（转）

(defun c:tanhuang(/)
  (setq p1 (getpoint "请指定螺旋线基点："))
  (setq r (getreal "请输入弹簧平均半径："))
  (setq d0 (getreal "请输入弹簧丝直径："))
  (setq disp (getreal "请输入弹簧节距："))
  (setq n0 (getint "请输入弹簧工作圈数："))
  (setq n (getint "请输入每圈细化段数 （32/36/40/44/48/52/56/60） ："))
  (setq n1 (* 1.25 n))            ;支撑圈细化段数  
  (setq n1 (fix n1))
  (setq n2 (* n0 n))            ;工作圈细化段数
  (setq delta (/ (* 2.0 pi) n))   ;单位转角
  (setq j (/ disp n))           ;工作圈轴向位移量   
  (setq j0 (/ d0 n))            ;支撑圈轴向位移量
  (setq bb (caddr p1))
  (setq ang 0)
  (setq jj 0)
  (command "ucs" "n" p1)
  (setq pt1 (list r 0 0))
  (command "3dpoly" pt1)
  (repeat n1                         ;绘制下支撑圈
    (setq jj (+ jj 1))
    (setq ang (+ delta ang))
    (setq pt (list (* r (cos ang)) (* r (sin ang )) (* j0 jj)))
    (command pt)
  )
  (setq p2 (list 0 0 (* j0 jj)))
  (setq g1 (* j0 jj))           ;下支撑圈高度
  (setq jj 0)
  (repeat n2                         ;绘制工作圈
    (setq jj (+ jj 1))
    (setq ang (+ delta ang))
    (setq pt (list (* r (cos ang )) (* r (sin ang)) (+ g1  (* j jj))))
    (command pt)
  )
  (setq p3 (list 0 0  (* j jj)))
  (setq g2 (* j jj))            ;工作圈高度
  (setq jj 0)
  (repeat n1                          ;绘制上支撑圈
    (setq jj (+ jj 1))
    (setq ang (+ delta ang))
    (setq pt (list (* r (cos ang))  (* r (sin ang))  (+ g1 g2 (* j0 jj))))
    (command pt)
  )
  (setq g3 (* j0 jj))   ;上支撑圈高度
  (command "")
  (setq e1 (entlast ))
  (command "ucs" "x" "")
  (command "circle" pt1 (/ d0 2))
  (setq e2 (entlast))
  (command "extrude" e2 "" "p" e1)   ;拉伸弹簧
  (setq e3 (entlast))
  (setq pt2 (list r (/ d0 4) 0))
  (setq py (+ g1 g2 g3 (- 0 (/ d0 4))))
  (setq pt3 (list (- 0 r) py 0))
  (command "slice" e3 "" "zx" pt2 pt3)    ;磨平端部支撑面
  (command "slice" e3 "" "zx" pt3 pt2)
  (command "ucs" "w")
)

scu_mvm

好贴，怎么没有人顶啊？

zbl_1045

好贴，谢谢。
不过烦请再介绍一下如何装到ACAD中，如何用。

yanth

回3楼: 将程序存为.txt文本,存完后将其文件扩展名改为.lsp ;启动AutoCAD,在工具菜单选Autolisp选项,加载程序;加载成功后即可在命令行输入tanhuang,选参数,就可以画弹簧了.

D.Y.Zhu

这是我用它画的弹簧

笨牛

我下了好用，谢谢！
谁能写一个可以画变形弹簧的程序就好了，我最近在画二种弹簧，中间粗两头细的锤形弹簧和底粗上细的圆台型弹簧。就是画不出来啊。

D.Y.Zhu

回复6楼，我以前有过那个程序，不过他只可以画螺旋线，所以后来我就删了，现在不好找了。

笨牛

回7楼的话，能写程序就是高手阿，谢谢你！可以继续写一个。这种弹簧虽不常见，也是很有用的。
另外请搂主看一下这个程序：
; AutoPOL (R) for Windows
;
; AutoCAD LINK Source file
;
; Copyright (C) FCC Software AB 2002. All rights reserved.
;
; By Clarence Carlsson
;
;
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun afw_edit( /        savename filename savename_no_suffix filename_no_suffix savename_pol
                                        path_autopol_exe path_autopol path_autopol_bat file_bat        apolexe        apolcmd )
       
        (setvar "cmdecho" 0)

        (setq savename (getvar "savename"))
        (setq filename (getvar "dwgname"))
       
        (if (= savename "" ) (progn
                (command "_.qsave")
                (command) ; Cancel qsave
                (setq savename (getvar "savename"))
                (setq filename (getvar "dwgname"))
                )
        )

        (if (/= savename "" ) (progn

                (setq savename_no_suffix (substr savename 1 (- (strlen savename) 4 )))
                (setq filename_no_suffix (substr filename 1 (- (strlen filename) 4 )))

                (setq savename_pol (strcat savename_no_suffix ".pol" ) )

                ;        Search for AutoPOL Executable

                (setq path_autopol_exe (findfile "autopol.exe"))

                (if (/= path_autopol_exe nil) (progn

                        ;        Create DOS BAT file to execute AutoPOL

                        (setq path_autopol (substr path_autopol_exe 1 (- (strlen path_autopol_exe) (strlen "\\autopol.exe"))  ))
                        (setq path_autopol_bat (strcat path_autopol "\\run_apol.bat" ))
                        (setq file_bat (open path_autopol_bat "w"))

                        (write-line "echo off" file_bat)
                        (write-line "cls" file_bat)
                        (write-line "echo Running AutoPOL for Windows." file_bat)
                        (write-line "echo This window will close when AutoPOL is terminated." file_bat)

                        ;
                        ; Create Search path to AutoPOL including double backslash...
                        ;
                        (setq apolexe (strcat "\"" path_autopol_exe "\"" ))
                        (setq apolcmd (strcat apolexe " \"" savename_pol "\" /AutoCAD"))
                       
                        (write-line apolcmd file_bat)
                        (close file_bat)

                        ;        Run DOS BAT file

                        (command "sh" (strcat "\"" path_autopol_bat "\""))

                        ) ; end progn
                       
                        ;        Can not locate AutoPOL

                        (alert "Can not find AutoPOL.exe\nMake sure the AutoPOL installation\ndirectory is added to the\nAutoCAD support directory.")


                );endif

                ) (progn

                        (alert "Save your drawing first")
                )
        )
        (princ)
)

(defun afw_update_dwg( /        savename filename savename_no_suffix filename_no_suffix savename_pol )
        (setvar "cmdecho" 0)

        (setq savename (getvar "savename"))
        (setq filename (getvar "dwgname"))

        (if (= savename "" ) (progn
                (command "_.qsave")
                (command) ; Cancel qsave
                (setq savename (getvar "savename"))
                (setq filename (getvar "dwgname"))
                )
        )

        (if (/= savename "" ) (progn

                (setq savename_no_suffix (substr savename 1 (- (strlen savename) 4 )))
                (setq filename_no_suffix (substr filename 1 (- (strlen filename) 4 )))

                (setq savename_pol (strcat savename_no_suffix ".pol" ) )

                ( if ( /= (findfile savename_pol) nil )
                        (afw_import savename_no_suffix filename_no_suffix )
                        (alert "No AutoPOL file exists.\nCan not update")
                );endif

                ) (progn
                        (alert "Save your drawing first")
                )
        )

        (princ)
)

(defun afw_insert_views( /        savename filename savename_no_suffix filename_no_suffix savename_view_dxf
                                                        blockname_view_dxf insertcmd )
        (setvar "cmdecho" 0)

        (setq savename (getvar "savename"))
        (setq filename (getvar "dwgname"))

        (if (/= savename "" ) (progn

                (setq savename_no_suffix (substr savename 1 (- (strlen savename) 4 )))
                (setq filename_no_suffix (substr filename 1 (- (strlen filename) 4 )))

                (setq savename_view_dxf (strcat savename_no_suffix "_views.dxf" ) )
                (setq blockname_view_dxf (strcat filename_no_suffix "_views" ) )
                (setq insertcmd (strcat blockname_view_dxf "=" savename_view_dxf ) )

                (if ( /= (findfile savename_view_dxf) nil ) (progn
                                (princ "\nInsert Views :")
                                (command "_-insert" insertcmd "\\" "" "" "")
                        )
                                (alert "No View-file exists to insert.\nRun AutoPOL to create.")
                        )
                )

                (alert "No View-file exists")

        )
        (princ)
)

(defun afw_insert_pattern( /        savename filename savename_no_suffix filename_no_suffix savename_pattern_dxf
                                                                blockname_pattern_dxf insertcmd )
        (setvar "cmdecho" 0)

        (setq savename (getvar "savename"))
        (setq filename (getvar "dwgname"))

        (if (/= savename "" ) (progn

                (setq savename_no_suffix (substr savename 1 (- (strlen savename) 4 )))
                (setq filename_no_suffix (substr filename 1 (- (strlen filename) 4 )))

                (setq savename_pattern_dxf (strcat savename_no_suffix "_pattern.dxf" ) )
                (setq blockname_pattern_dxf (strcat filename_no_suffix "_pattern" ) )
                (setq insertcmd (strcat blockname_pattern_dxf "=" savename_pattern_dxf ) )

                (if ( /= (findfile savename_pattern_dxf) nil ) (progn
                                (princ "\nInsert Pattern :")
                                (command "_-insert" insertcmd "\\" "" "" "")
                        )
                                (alert "No Pattern-file exists to insert.\nRun AutoPOL to create.")
                        )
                )
                (alert "No Pattern-file exists")
        )
        (princ)
)

(defun afw_import ( savename_no_suffix filename_no_suffix /        savename_view_dxf blockname_view_dxf insertcmd
                                                                                                                        savename_pattern_dxf blockname_pattern_dxf )

        (setq savename_view_dxf (strcat savename_no_suffix "_views.dxf" ) )
        (setq blockname_view_dxf (strcat filename_no_suffix "_views" ) )
        (setq insertcmd (strcat blockname_view_dxf "=" savename_view_dxf ) )
        ;(command "_-insert" insertcmd "0,0,0" "" "" "")
        (command "_-insert" insertcmd )
        (command)
;        (entdel (entlast) )

        (setq savename_pattern_dxf (strcat savename_no_suffix "_pattern.dxf" ) )
        (setq blockname_pattern_dxf (strcat filename_no_suffix "_pattern" ) )
        (setq insertcmd (strcat blockname_pattern_dxf "=" savename_pattern_dxf ) )
        ;(command "_-insert" insertcmd "0,0,0" "" "" "")
        (command "_-insert" insertcmd )
        (command)
;        (entdel (entlast) )

)

(princ)


这是AutoPOL 板金展开专家里的一个CAD加载程序，我不懂程序，这个程序好像是加载给AutoCAD 2002版的，我现在用的是2006版的CAD ，加载失败。

D.Y.Zhu

回8楼：
谢谢你提供的程序，我会下载试用的，请等我试用的结果。

zbjgzjy

好的我也试试看。。。。。
加载了 。
怎么试用呀，，，？请教各位高手

笨牛

这个程序没有问题，原来加载不上是我做的不对，我仔细看了AutoPOL的帮助文件后现在已经正确加载了，AutoCAD菜单栏里的AutoPOL  of  windows  菜单已经好用了。可以在AutoCAD中正确启动AutoPOL了。详情看AutoPOL帮助文件。

zhangbing521111

草草

sunshine-315

这么厉害啊，原来CAD还有这么多学问啊！