- 积分
- 1472
- 明经币
- 个
- 注册时间
- 2004-5-8
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
发表于 2005-4-7 13:41:00
|
显示全部楼层
Autodesk提供的源程序
;;; 3DSPIRAL.LSP ; Copyright (C) 1992 by Autodesk, Inc. ; ; Permission to use, copy, modify, and distribute this software ; for any purpose and without fee is hereby granted, provided ; that the above copyright notice appears in all copies and that ; both that copyright notice and this permission notice appear in ; all supporting documentation. ; ; THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED ; WARRANTY. ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR ; PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED. ;;; --------------------------------------------------------------------------; ;;; DESCRIPTION ;;; ;;; This is a programming example. ;;; ;;; Designed and implemented by Kelvin R. Throop in January 1985 ;;; ;;; This program constructs a spiral. It can be loaded and called ;;; by typing either "spiral", "3dspiral" or the following: ;;; (cspiral <# rotations> <base point> <horiz growth per rotation> ;;; <points per circle> <start radius> ;;; <vert growth per rotation>). ;;; ;;; --------------------------------------------------------------------------;
(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.141596235 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 "mline" 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) )
;;; ;;; Interactive spiral generation ;;;
(defun C:SPIRAL (/ olderr ocmd oblp nt bp cf 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 3) ; cf must not be zero, or null (setq cf (getdist "\nGrowth per rotation: ")) (initget 6) ; lp must not be zero or neg (setq lp (getint "\nPoints per rotation <30>: ")) (cond ((null lp) (setq lp 30))) (cspiral nt bp cf lp nil nil) (setvar "cmdecho" ocmd) (setvar "blipmode" oblp) (setq *error* olderr) ; Restore old *error* handler (princ)
)
;;; ;;; Interactive spiral generation ;;;
(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: ")) (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>: ")) (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)
)
;;; --------------------------------------------------------------------------; (princ "\n\tC:SPIRAL and C:3DSPIRAL loaded. ") (princ)
|
|