《lisp编程实例》由会员分享，可在线阅读，更多相关《lisp编程实例（11页珍藏版）》请在金锄头文库上搜索。
1、Visual LISP 编程应用实例集一、 计算类程序1.计算阶剩值n! (注意：采用了递归方式)(defun jsen (n) (if (= n 0) 1 (* n (jsen (1- n);2.迭代计算（）(defun ddai (x)(setq x1 0 x2 x e 1.0e-5 i 0)(while ( (abs (- x2 x1) e) (setq x1 x2) (setq x2 (expt (+ x1 1) (/ 1 3.0) (setq i (1+ i);while(print x=) (princ x2) (print i=) (princ i) (princ);end3.一
2、元二次方程求解()(defun px2 (a b c)(setq d (- (expt b 2.0) (* 4 a c)(cond ( d 0) (progn (setq x1 (/ (- (sqrt d) b) (* 2.0 a) x2 (/ (+ (sqrt d) b) (* -2.0 a) (prompt nTwo root! x1=) (princ x1) (prompt x2=) (princ x2);cond(princ);end4.成绩分析统计注意：使用该程序前须将全班成绩输入一个数据文件中保存，格式为（78 89 67 .）(defun sjfx (fname)(setq f
3、(open fname r) (setq lb nil) (while (setq sd (read-line f) (setq lb (append lb (read sd)(close f) (setq xsum 0) (foreach x lb (setq xsum (+ x xsum) (setq n (length lb) xb 0)(setq xbar (/ xsum (* 1.0 n) (foreach x lb (setq xb (+ xb (* (- x xbar) (- x xbar)(setq xbzc (sqrt (/ xb (* 1.0 n) (repeat 18 (
4、terpri)(prompt * 统计结果 *) (terpri)(prompt (strcat 全班总平均分数 X= (rtos xbar 2 3) (terpri)(prompt (strcat 标准差 = (rtos xbzc 2 3) (terpri)(prompt (strcat Total number: N= (rtos n 2 0) (terpri)(prompt *) (terpri)(princ);end二、数据检索类1.根据计算模数检索标准模数值(假定mc为110之间的任意值，以实参代入)(defun jsm (mc)(setq ml (1 1.25 1.5 2 2.5
5、3 4 5 6 8 10) (setq m 0 n 0)(while ( m mc) (setq m (nth n ml) n (1+ n);while(prompt (strcat nm= (rtos m 2 1)(princ);end2.检索一类数据文件（一类数据文件必须存在，且数据格式必须统一）(defun js1 (fname kd / ft nt j x)(setq f (open fname r) (setq ft (read (read-line f) nt (read (read-line f)(while (/= kd (car nt) (setq nt (read (rea
6、d-line f) ;while (setq j -1) (repeat (length nt) (setq j (1+ j) x (nth j ft) (set x (nth j nt)；reapeat(close f) nt);end3.检索二类数据文件（二类数据文件必须存在，且数据格式必须统一）(defun js2 (fname kd / ft nt j x)(setq f (open fname r) (setq ft (read (read-line f) nt (read (read-line f)(while (or ( kd (cadr nt) (setq nt (read (
7、read-line f);while(setq j -1) (repeat (length nt) (setq j (1+ j) x (nth j ft) (set x (nth j nt);repeat(close f) nt);end三、 参数化绘图类1.绘制正弦曲线函数y=sinx (注意：计算数据存放在表变量lpt中)(Defun C:Dsin(/ x n z s dx cm bl x0 y0) (SetQ x 0 P (GetPoint n基点：) x0 (Car p) y0 (Cadr p) n (GetInt n精度（全线上直线片段数）：) z (GetReal n周期数：) s
8、 (GetReal n波高系数：) dx (/ (* z 2 Pi) n) ) (SetQ cm (GetVar cmdecho) bl (GetVar blipmode) os (GetVar osmode) ) (SetVar cmdecho 0) (SetVar blipmode 0) (SetVar osmode 0) (Command pline p) (Repeat n (SetQ x (+ x dx) (Command (List (+ x0 x) (+ y0 (* s (Sin x) ) (Command ) (SetVar cmdecho cm) (setvar blipmo
9、de bl) (setvar osmode os) (PrinC) )2.装有键的轴或孔的图形绘制（注：平键数据存于二类数据文件jc.dat中）(defun jcz (d flag / x1 x2 x cp pt1 pt2 pt3 pt4 t1)(if (not js2) (load d:/cad_1/js2) (js2 d:/cad_1/jc.dat d)(initget 6) (setq cp (getpoint nCenter point:) (command ucs o cp)(setq x1 (expt (* 0.5 d) 2.0) x2 (expt (* 0.5 b) 2.0) (
10、setq x (sqrt (- x1 x2)(if (= flag 1) (setq t1 tz) (setq t1 (* -1 tk)(setq pt1 (list x (* 0.5 b) pt2 (list (- (* 0.5 d) t1) (* 0.5 b) pt3 (polar pt2 (* 1.5 pi) b) pt4 (polar pt1 (* 1.5 pi) b)(command pline pt1 a ce 0,0 pt4 l pt3 pt2 pt1 )(if (= flag 1) (command hatch u 45 4 l ) (command layer s cente
11、r )(command line (polar (0 0) pi (+ 3 (* 0.5 d) (polar (0 0) 0 (+ 3 (* 0.5 d) )(command line (polar (0 0) (* 0.5 pi) (+ 3 (* 0.5 d) (polar (0 0) (* 1.5 pi) (+ 3 (* 0.5 d) )(command layer s 0 ) (princ);end3.绘制阴阳图形 (defun yinyang (r) (setq bp (getpoint nEnter center point:) (command color 2) (command
12、circle bp r) (command pline (polar bp (* 0.5 pi) r) a bp (polar bp (* 1.5 pi) r) ) (command bhatch p s (polar bp (* 0.5 pi) (* 0.5 r) ) (command color 1) (command bhatch p s (polar bp (* 1.5 pi) (* 0.5 r) ) );end4.绘制一个五角星图案(defun star_5 (r)(command color 1) (setq cp (getpoint nCenter point:)(setqpt1
13、 (polar cp (* 0.017453 18) r) pt2 (polar cp (* 0.017453 54) r) p2 (polar cp (* 0.5 pi) r)(setqp1 (inters cp pt2 pt1 (polar pt1 pi r) p3 (polar cp (* 0.017453 126) (distance cp p1)(command pline cp p1 p2 p3 cp p2 ) (setq s (ssadd (entlast)(command bhatch p s (polar cp (* 0.017453 70) (* 0.2 r) ) (setq s (ssadd (entlast) s)(command color 2) (command bhatch p s (polar cp (* 0.017453 95) (* 0.2 r) )(setq s (ssadd (entlast) s)(command array s p cp 5 )(princ);end5.绘制图框(n=0,15)(defun tk (n)(setq lpt (1189
