[LISP程序]：生成二维、三维螺旋线程序！【借花献佛】

风子

2. 
   
3. [FONT=courier new]
   
4. ;;; 3DSPIRAL.LSP
   
5. ;     Copyright (C) 1992 by Autodesk, Inc.
   
6. ; modified by CAD Studio, 2001 (globalization)
   
7. ; 修改者：明经通道 [url]http://www.mccad.net[/url] 2001 (中文化)
   
8. ;
   
9. ;     Permission to use, copy, modify, and distribute this software
   
10. ;     for any purpose and without fee is hereby granted, provided
    
11. ;     that the above copyright notice appears in all copies and that
    
12. ;     both that copyright notice and this permission notice appear in
    
13. ;     all supporting documentation.
    
14. ;
    
15. ;     THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED
    
16. ;     WARRANTY.  ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR
    
17. ;     PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED.
    
18. ;;; --------------------------------------------------------------------------;
    
19. ;;; DESCRIPTION
    
20. ;;;
    
21. ;;;   这是一个程序实例。
    
22. ;;;
    
23. ;;;   由 Kelvin R. Throop 于 1985 年 1 月设计编制。
    
24. ;;;
    
25. ;;;   该程序生成一螺旋线。它可通过输入“spiral”、“3dspiral”来加载及调用，
    
26. ;;;   也可以通过以下表达式调用：
    
27. ;;;   (cspiral <# 旋转圈数> <基点> <每圈的水平增加距离>
    
28. ;;;            <每圈的点数> <起始半径>
    
29. ;;;            <每圈的垂直上升距离>).
    
30. ;;;
    
31. ;;; --------------------------------------------------------------------------;
    
32. 
    
33. (defun myerror (s)                    ; 如果出错 (如按 CTRL-C)
    
34.                                       ; 将激活该命令...
    
35.   (if (/= s "Function cancelled")
    
36.     (princ (strcat "\n出错: " s))
    
37.   )
    
38.   (setvar "cmdecho" ocmd)             ; 恢复保存的模式
    
39.   (setvar "blipmode" oblp)
    
40.   (setq *error* olderr)               ; 恢复旧的 *error* 处理
    
41.   (princ)
    
42. )
    
43. 
    
44. (defun cspiral (ntimes bpoint hfac lppass strad vfac
    
45.                 / ang dist tp ainc dhinc dvinc circle dv)
    
46. 
    
47.   (setvar "blipmode" 0)               ; 关闭亮显
    
48.   (setvar "cmdecho" 0)                ; 关闭命令行提示
    
49.   (setq circle (* 3.141596235 2))
    
50.   (setq ainc (/ circle lppass))
    
51.   (setq dhinc (/ hfac lppass))
    
52.   (if vfac (setq dvinc (/ vfac lppass)))
    
53.   (setq ang 0.0)
    
54.   (if vfac
    
55.     (setq dist strad dv 0.0)
    
56.     (setq dist 0.0)
    
57.   )
    
58.   (if vfac
    
59.     (command "_3dpoly")                ; 开始螺旋 ...
    
60.     (command "_pline" bpoint)          ; 由基点开始螺旋...
    
61.   )
    
62.   (repeat ntimes
    
63.     (repeat lppass
    
64.       (setq tp (polar bpoint (setq ang (+ ang ainc))
    
65.                       (setq dist (+ dist dhinc))
    
66.                )
    
67.       )
    
68.       (if vfac
    
69.           (setq tp (list (car tp) (cadr tp) (+ dv (caddr tp)))
    
70.                 dv (+ dv dvinc)
    
71.           )
    
72.       )
    
73.       (command tp)                    ; 继续绘制下个点...
    
74.     )
    
75.   )
    
76.   (command "")                        ; 直到完成。
    
77.   (princ)
    
78. )
    
79. 
    
80. ;;;
    
81. ;;;       交互螺旋生成
    
82. ;;;
    
83. 
    
84. (defun C:SPIRAL (/ olderr ocmd oblp nt bp cf lp)
    
85.   ;;;;(setq olderr  *error*
    
86.   ;;;;      *error* myerror)
    
87.   (setq ocmd (getvar "cmdecho"))
    
88.   (setq oblp (getvar "blipmode"))
    
89.   (setvar "cmdecho" 0)
    
90.   (initget 1)                         ; bp 必须为非空值
    
91.   (setq bp (getpoint "\n中心点: "))
    
92.   (initget 7)                         ; nt 必须为非零正数或非空值
    
93.   (setq nt (getint "\n螺旋圈数: "))
    
94.   (initget 3)                         ; cf 必须为非零或非空值
    
95.   (setq cf (getdist "\n每圈增加距离: "))
    
96.   (initget 6)                         ; lp 必须为非零正数
    
97.   (setq lp (getint "\n每圈的点数<30>: "))
    
98.   (cond ((null lp) (setq lp 30)))
    
99.   (cspiral nt bp cf lp nil nil)
    
100.   (setvar "cmdecho" ocmd)
     
101.   (setvar "blipmode" oblp)
     
102.   (setq *error* olderr)               ; 恢复旧的 *error* 处理
     
103.   (princ)
     
104. 
     
105. )
     
106. 
     
107. ;;;
     
108. ;;;       Interactive spiral generation
     
109. ;;;
     
110. 
     
111. (defun C:3DSPIRAL (/ olderr ocmd oblp nt bp hg vg sr lp)
     
112.   ;;;;(setq olderr  *error*
     
113.   ;;;;      *error* myerror)
     
114.   (setq ocmd (getvar "cmdecho"))
     
115.   (setq oblp (getvar "blipmode"))
     
116.   (setvar "cmdecho" 0)
     
117.   (initget 1)                         ; bp 必须为非空值
     
118.   (setq bp (getpoint "\n中心点: "))
     
119.   (initget 7)                         ; nt 必须为非零正数或非空值
     
120.   (setq nt (getint "\n螺旋圈数: "))
     
121.   (initget 7)                         ; sr 必须为非零正数或非空值
     
122.   (setq sr (getdist bp "\n起点半径: "))
     
123.   (initget 1)                         ; hg 必须为非空值
     
124.   (setq hg (getdist "\n水平每圈增加距离: "))
     
125.   (initget 3)                         ; vg 必须为非零或非空值
     
126.   (setq vg (getdist "\n垂直每圈上升距离: "))
     
127.   (initget 6)                         ; lp 必须为非零正数
     
128.   (setq lp (getint "\n每圈的点数 <30>: "))
     
129.   (cond ((null lp) (setq lp 30)))
     
130.   (cspiral nt bp hg lp sr vg)
     
131.   (setvar "cmdecho" ocmd)
     
132.   (setvar "blipmode" oblp)
     
133.   (setq *error* olderr)               ; 恢复旧的 *error* 处理
     
134.   (princ)
     
135. 
     
136. )
     
137. 
     
138. ;;; --------------------------------------------------------------------------;
     
139. (princ "\n\tC:SPIRAL 和 C:3DSPIRAL 已加载。 ")
     
140. (princ)[/FONT]

<br /> [FONT=courier new]<br /> ;;; 3DSPIRAL.LSP<br /> ;     Copyright (C) 1992 by Autodesk, Inc.<br /> ; modified by CAD Studio, 2001 (globalization)<br /> ; 修改者：明经通道 [url]http://www.mccad.net[/url] 2001 (中文化)<br /> ;<br /> ;     Permission to use, copy, modify, and distribute this software <br /> ;     for any purpose and without fee is hereby granted, provided <br /> ;     that the above copyright notice appears in all copies and that <br /> ;     both that copyright notice and this permission notice appear in <br /> ;     all supporting documentation.<br /> ;<br /> ;     THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED<br /> ;     WARRANTY.  ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR<br /> ;     PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED.<br /> ;;; --------------------------------------------------------------------------;<br /> ;;; DESCRIPTION<br /> ;;;<br /> ;;;   这是一个程序实例。<br /> ;;;<br /> ;;;   由 Kelvin R. Throop 于 1985 年 1 月设计编制。<br /> ;;;<br /> ;;;   该程序生成一螺旋线。它可通过输入“spiral”、“3dspiral”来加载及调用，<br /> ;;;   也可以通过以下表达式调用：<br /> ;;;   (cspiral <# 旋转圈数> <基点> <每圈的水平增加距离><br /> ;;;            <每圈的点数> <起始半径> <br /> ;;;            <每圈的垂直上升距离>).<br /> ;;;<br /> ;;; --------------------------------------------------------------------------;<br /> <br /> (defun myerror (s)                    ; 如果出错 (如按 CTRL-C)<br />                                       ; 将激活该命令...<br />   (if (/= s "Function cancelled")<br />     (princ (strcat "\n出错: " s))<br />   )<br />   (setvar "cmdecho" ocmd)             ; 恢复保存的模式<br />   (setvar "blipmode" oblp)<br />   (setq *error* olderr)               ; 恢复旧的 *error* 处理<br />   (princ)<br /> )<br /> <br /> (defun cspiral (ntimes bpoint hfac lppass strad vfac<br />                 / ang dist tp ainc dhinc dvinc circle dv)<br /> <br />   (setvar "blipmode" 0)               ; 关闭亮显<br />   (setvar "cmdecho" 0)                ; 关闭命令行提示<br />   (setq circle (* 3.141596235 2))<br />   (setq ainc (/ circle lppass))<br />   (setq dhinc (/ hfac lppass))<br />   (if vfac (setq dvinc (/ vfac lppass)))<br />   (setq ang 0.0)<br />   (if vfac<br />     (setq dist strad dv 0.0)<br />     (setq dist 0.0)<br />   )<br />   (if vfac <br />     (command "_3dpoly")                ; 开始螺旋 ...<br />     (command "_pline" bpoint)          ; 由基点开始螺旋...<br />   )<br />   (repeat ntimes <br />     (repeat lppass <br />       (setq tp (polar bpoint (setq ang (+ ang ainc))<br />                       (setq dist (+ dist dhinc))<br />                )<br />       )<br />       (if vfac<br />           (setq tp (list (car tp) (cadr tp) (+ dv (caddr tp)))<br />                 dv (+ dv dvinc)<br />           )<br />       )<br />       (command tp)                    ; 继续绘制下个点...<br />     )<br />   ) <br />   (command "")                        ; 直到完成。<br />   (princ)<br /> ) <br /> <br /> ;;;<br /> ;;;       交互螺旋生成<br /> ;;;<br /> <br /> (defun C:SPIRAL (/ olderr ocmd oblp nt bp cf lp) <br />   ;;;;(setq olderr  *error*<br />   ;;;;      *error* myerror)<br />   (setq ocmd (getvar "cmdecho"))<br />   (setq oblp (getvar "blipmode"))<br />   (setvar "cmdecho" 0)<br />   (initget 1)                         ; bp 必须为非空值<br />   (setq bp (getpoint "\n中心点: "))<br />   (initget 7)                         ; nt 必须为非零正数或非空值<br />   (setq nt (getint "\n螺旋圈数: "))<br />   (initget 3)                         ; cf 必须为非零或非空值<br />   (setq cf (getdist "\n每圈增加距离: "))<br />   (initget 6)                         ; lp 必须为非零正数<br />   (setq lp (getint "\n每圈的点数<30>: "))<br />   (cond ((null lp) (setq lp 30))) <br />   (cspiral nt bp cf lp nil nil)<br />   (setvar "cmdecho" ocmd)<br />   (setvar "blipmode" oblp)<br />   (setq *error* olderr)               ; 恢复旧的 *error* 处理<br />   (princ)<br /> <br /> ) <br /> <br /> ;;;<br /> ;;;       Interactive spiral generation<br /> ;;;<br /> <br /> (defun C:3DSPIRAL (/ olderr ocmd oblp nt bp hg vg sr lp) <br />   ;;;;(setq olderr  *error*<br />   ;;;;      *error* myerror)<br />   (setq ocmd (getvar "cmdecho"))<br />   (setq oblp (getvar "blipmode"))<br />   (setvar "cmdecho" 0)<br />   (initget 1)                         ; bp 必须为非空值<br />   (setq bp (getpoint "\n中心点: "))<br />   (initget 7)                         ; nt 必须为非零正数或非空值<br />   (setq nt (getint "\n螺旋圈数: "))<br />   (initget 7)                         ; sr 必须为非零正数或非空值<br />   (setq sr (getdist bp "\n起点半径: "))<br />   (initget 1)                         ; hg 必须为非空值<br />   (setq hg (getdist "\n水平每圈增加距离: "))<br />   (initget 3)                         ; vg 必须为非零或非空值<br />   (setq vg (getdist "\n垂直每圈上升距离: "))<br />   (initget 6)                         ; lp 必须为非零正数<br />   (setq lp (getint "\n每圈的点数 <30>: "))<br />   (cond ((null lp) (setq lp 30))) <br />   (cspiral nt bp hg lp sr vg)<br />   (setvar "cmdecho" ocmd)<br />   (setvar "blipmode" oblp)<br />   (setq *error* olderr)               ; 恢复旧的 *error* 处理<br />   (princ)<br /> <br /> ) <br /> <br /> ;;; --------------------------------------------------------------------------;<br /> (princ "\n\tC:SPIRAL 和 C:3DSPIRAL 已加载。 ")<br /> (princ)[/FONT]