lisp编程实例 ).doc

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.一元二次方程求解()(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 (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 (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 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 (read-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 (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 ds (/ x0 xe x y pt)(setq bp (getpoint n给出基点:)(command ucs o bp) (setq scx 10 scy 20) (setq x0 0 xe (* pi 2) x 0 y 0) (setq step (/ xe 180.0)(while (= x0 (* scx xe) (setq y (* scy (sin x) (setq lpt (append lpt (list (list x0 y) (setq x0 (+ x0 (* scx step) x (+ x step);while(setq lpt (append lpt (list (list (* scx xe) 0)(command leader (list (+ (* scx xe) 10) 0) 0,0 n)(command leader (list 0 (+ scy 10) 0,0 n)(command pline) (foreach pt lpt (command pt) (command )(princ);end2.装有键的轴或孔的图形绘制（注：平键数据存于二类数据文件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) (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 center )(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 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 (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 841 594 420 297 210 148)(setq l (nth n lpt) b (nth (+ n 1) lpt)(if ( a (* 2 pi) (command 0,0 ucs w)(t (command (list (sin (* 2.0 a) (sin (* 5.0 a) (draw_xy_aux (+ a 0.05);cond );end7.绘制参数曲线x=sin5a.cosa, y=sin5a.sin4a（注意：采用了数据文件读、写方式）(defun qx_xy ()(setq f (open qx.dat w) (setq a 0)(while ( a (* 2 pi) (setq x (* (sin (* 5 a) (cos a) y (* (sin (* 5 a) (sin (* 4 a)(princ x f) (princ , f) (princ y f) (princ n f) (setq a (+ a 0.05);while(princ 0,0 f) (close f)(draw_qx) (princ);main;-(defun draw_qx ()(setq bp (getpoint nEnter base point:)(command ucs o bp pline)(setq f (open qx.dat r)(while (setq pt (read-line f) (command pt)(close f)(command ucs w)(princ);end8.绘制由方程y=cos(0.9x)产生的图形（注：计算数据存放于表变量lpt中）(defun c:spr (/ cp lpt x)(setq cp (getpoint nCenter point:)(setq x 0 lpt nil)(repeat (fix (1+ (/ (* 20 pi) 0.2)(setq lpt (append lpt (list (polar cp x (cos (* 0.9 x)(setq x (+ x 0.2);repeat(setq lpt (append lpt (list (polar cp (* 20 pi) 1) )(command pline)(foreach pt lpt (command pt)(princ);end四、 对话框编程实例1定制对话框zdbx:dialoglabel=带圆正多边形;:row:boxed_column:edit_boxlabel=边数;key=number;value=6;:edit_boxlabel=半径;key=rad;value=20;:boxed_column:radio_buttonlabel=内接圆;key=nq;:radio_buttonlabel=外切圆;key=wq;value=1; ok_cancel;2程序驱动(defun dbx ()(setq id (load_dialog e:/jscad/zdbx)(if ( what 0) (draw_zdbx n r flag);end;-(defun draw_zdbx (n r flag) (setq bp (getpoint nBase point:) (command circle bp r) (command polygon n bp flag r) );-(defun qsj ()(setq n (atoi (get_tile number)(setq r (atof (get_tile rad)(if (= fg 1) (setq flag i) (setq flag c)(setq what 1);end五局部菜单设计编程实例/*MENUGROUP=用户菜单*POP1用户菜单-平键联接圆头平键cc(if (not aj) (load d:/cad_1/aj) (aj)半圆头键cc(if (not bj) (load d:/cad_1/bj) (bj)方型平键cc(if (not cj) (load d:/cad_1/cj) (cj)键槽轴面cc(if (not jcz) (load d:/cad_1/jcz) (jcz 1)图纸幅面A0幅面ccrectangle 0,0 1189,841 rectangle 25,10 1179,831A1幅面ccrectangle 0,0 841,594 rectangle 25,10 831,584A2幅面ccrectangle 0,0 594,420 rectangle 25,10 584,410A3幅面ccrectangle 0,0 420,297 rectangle 25,10 410,287A4幅面ccrectangle 0,0 297,210 rectangle 25,5 287,205-A5幅面ccrectangle 0,0 210,147 rectangle 25,5 200,142-标题栏CC(command insert d:/cad_1/btl pause pause)粗糙度CC(command insert d:/cad_1/czd1 pause pause)基准符号cc(command insert d:/cad_1/jzfh pause pause)清屏幕cc(if (not cls) (load d:/cad_1/cls) cls;-圆多边形CC(if (not dbx) (load e:/jscad/zdbx) (dbx)-(说明：该程序仅用于CAD软件二次开发课程学习参考和上机训练，不得随意传抄) 梯形 (defun dytx (sd xd gd) (setq bp (getpoint nEnter base point:) (command ucs o bp) (setq p1 (list (* 0.5 (- xd sd) gd) p2 (polar p1 0 sd) p3 (list xd 0) (command pline 0,0 p1 p2 p3 c) (command ucs w);end W 五角星(defun wjx (r) (setq cp (getpoint n指定中心点：) (setq p1 (polar cp (* 0.5 pi) r)p2 (polar cp (* 0.017453 162) r)p3 (polar cp (* 0.017453 234) r)p4 (polar cp (* 0.017453 306) r)p5 (polar cp (* 0.017453 18) r) (setq p12 (inters p1 p3 p2 p5)p23 (inters p1 p3 p2 p4)p34 (inters p2 p4 p3 p5)p45 (inters p1 p4 p3 p5)p15 (inters p1 p4 p2 p5) (command pline p1 p12 p2 p23 p3 p34 p4 p45 p5 p15 c) (command circle cp r) )鼓形(defun c:gx ()(setq c (getpoint input a point:)(command ucs o c)(setq h (getreal input h)(setq r (getreal input r) (setq p1 (list (sqrt (- (* r r) (* h h) )h)(setq p2 (list (- 0 (sqrt (- (* r r) (* h h) )h)(setq p3 (list (- 0 (sqrt (- (* r r) (* h h) )(- 0 h)(setq p4 (list (sqrt (- (* r r) (* h h) )(- 0 h)(command arc p4 en p1 r r)(command arc p2 en p3 r r)(command line p1 p2)(command line p4 p3)例子编程如下： (defun bolt (F b) (setq d1min (sqrt (/ (* 4 f) (* pi b) (princ “n松螺栓最小直径d1=”) (princ d1min) (princ) );end Command:(bolt 58