lisp编程实例

lisp编程实例

Visual LISP 编程应用实例集

一、计算类程序

1.计算阶剩值n! (注意:采用了递归方式)

(defun jsen (n)

(if (= n 0) 1 (* n (jsen (1- n)))));

3) 2.迭代计算(x,x,1,0

(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));end

23.一元二次方程求解() ax，bx，c,0

(defun px2 (a b c)

(setq d (- (expt b 2.0) (* 4 a c)))

(cond ((< d 0) (prompt "\nNo root!"))

((= d 0) (progn (setq x (/ b (* -2.0 a))) (prompt "\nOne root! x=") (princ x)))

((> 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));end

4.成绩分析统计

注意:使用该程序前须将全班成绩输入一个数据文件中保存，格式为(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为1~10之间的任意值，以实参代入)

(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));end

2.检索一类数据文件(一类数据文件必须存在，且数据格式必须统一)

(defun js1 (fname kd / ft nt j x)

1

(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);end

3.检索二类数据文件(二类数据文件必须存在，且数据格式必须统一)

(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 (car nt)) (> 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 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 (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 "blipmode" 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)) (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))

2

(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));end

3.绘制阴阳图形

(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)) "")

);end

4.绘制一个五角星图案

(defun star_5 (r)

(command "color" 1) (setq cp (getpoint "\nCenter point:"))

(setq pt1 (polar cp (* 0.017453 18) r) pt2 (polar cp (* 0.017453 54) r) p2 (polar cp (* 0.5 pi) r)) (setq p1 (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));end

5.绘制图框(n=0,1~5)

(defun tk (n)

(setq lpt '(1189 841 594 420 297 210 148))

(setq l (nth n lpt) b (nth (+ n 1) lpt))

(if (< n 3) (setq c 10) (setq c 5))

(command "rectangle" '(0 0) (list l b))

(command "rectangle" (list 25 c) (list (- l c) (- b c)))

);end

6.绘制参数曲线x=sin2a, y=sin5a [0~2pi](注意:采用了递归方式)

(defun draw_xy ()

(setq bp (getpoint "\nEnter base point:"))

(command "ucs" "o" bp)

(command "pline" (draw_xy_aux 0)));main

;--------------------------------------------------

(defun draw_xy_aux (a)

(cond ((> 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

);end

3

7.绘制参数曲线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)

);end

8.绘制由方程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:dialog{label="带圆正多边形";

:row{:boxed_column{

:edit_box{label="边数";key="number";value=6;}

:edit_box{label="半径";key="rad";value=20;}}

:boxed_column{

4

:radio_button{label="内接圆";key="nq";}

:radio_button{label="外切圆";key="wq";value=1;}}

}

ok_cancel;}

2(程序驱动

(defun dbx ()

(setq id (load_dialog "e:/jscad/zdbx")) (if (< id 0) (exit))

(if (not (new_dialog "zdbx" id)) (exit))

(action_tile "number" "(set_tile $key $value)")

(action_tile "rad" "(set_tile $key $value)")

(action_tile "nq" "(setq fg 1)")

(action_tile "wq" "(setq fg 0)")

(action_tile "accept" "(qsj) (done_dialog)")

(action_tile "cancel" "(setq what -1) (done_dialog)") (start_dialog) (unload_dialog id)

(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

[用户菜单]

[--]

[->平键联接]

[圆头平键]^c^c(if (not aj) (load "d:/cad_1/aj")) (aj) [半圆头

键]^c^c(if (not bj) (load "d:/cad_1/bj")) (bj) [方型平键]^c^c(if (not cj) (load "d:/cad_1/cj")) (cj) [键槽轴面]^c^c(if (not jcz) (load

"d:/cad_1/jcz")) (jcz 1) [<-键槽孔面]^c^c(if (not jcz) (load

"d:/cad_1/jcz")) (jcz 0)

5

[~--]

[->图纸幅面]

[A0幅面]^c^crectangle 0,0 1189,841 rectangle 25,10 1179,831 [A1幅

面]^c^crectangle 0,0 841,594 rectangle 25,10 831,584 [A2幅

面]^c^crectangle 0,0 594,420 rectangle 25,10 584,410 [A3幅

面]^c^crectangle 0,0 420,297 rectangle 25,10 410,287 [A4幅

面]^c^crectangle 0,0 297,210 rectangle 25,5 287,205 [<-A5幅

面]^c^crectangle 0,0 210,147 rectangle 25,5 200,142 [~--] [标题栏]^C^C(command "insert" "d:/cad_1/btl" pause "" "" pause) [粗

糙度]^C^C(command "insert" "d:/cad_1/czd1" pause "" "" pause) [基准符

号]^c^c(command "insert" "d:/cad_1/jzfh" pause "" "" pause) [清屏

幕]^c^c(if (not cls) (load "d:/cad_1/cls")) cls; [--]

[圆多边形]^C^C(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))

6

(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"")

)例子

编程如下:

4F (defun bolt (F b) d,1,[,] (setq d1min (sqrt (/ (* 4 f) (* pi b))))

(princ “\n松螺栓最小直径d1=”) (princ d1min) (princ)

);end

Command:(bolt 5800 180)

返回:松螺栓最小直径d1=6.4052

, 复选框:(Toggle/CheckBox)

, 单选按钮(Radio_Button)

, 选择按钮(Button)

, 编辑框(Edit_Box)

, 列表框(List_Box)

, 下拉式列表框(Popup_List)

, 滑块(Slider)

, 图像(Image)或图像按钮(image_button)

, 说明文字(Text)

:retirement_button{

7

label = "设计计算";

key = "accept";

is_default = true;

}

, dxan:dialog{

, label="确定图纸幅面";

, :boxed_radio_row{label="幅面规格";

, :radio_button{label="A0"; key="a0"; }

, :radio_button{label="A1"; key="a1"; }

, :radio_button{label="A2"; key="a2"; }

, :radio_button{label="A3"; key="a3"; }

, :radio_button{label="A4"; key="a4"; }

, :radio_button{label="A5"; key="a5"; value=1;} , }

, ok_cancel;

, }

zcl:dialog{label="渐开线直齿圆柱齿轮设计";

:row{

:list_box{label = "模数(mm)";key="m_number";

list="1.25\n1.5\n2\n2.5\n3\n4\n5\n6\n8\n10\n12

\n16\n20\n25\n32\n40\n50"; value=2;height=5;

}

:spacer{width=2;}

:boxed_column{

:edit_box{label=" 齿数&z";key="z_number";}

8

:edit_box{label="变位系数

x";key="x_number";value=0;} :edit_box{label="顶高系数

ha*";key="ha*";value=1.0;} :edit_box{label="顶隙系数

c*";key="c*";value=0.25;}

}

}

ok_cancel;}

9

绘制操场

本文列举一个简单的AutoLISP程序，每行附解释，让大家看看AutoLISP程序的样子。程序定义了一个命令:mslot，用多段线绘制如图所示的封闭图形，用户需要输入参数:a、b点坐标和宽度d。运行方法，讲代码复制到一文本文件中，另存为lsp格式的纯文本文件，在AutoCAD中加载该文件，然后输入命令mslot。

;| MSLOT, short for Milled SLOT

Copyright ? 1998 Ronald W. Leigh

Requests width and two center points.

Draws a polyline with two straight and two arc segments.

Variables:

a/b Centers

a1/a2 Endpoints of arc around a

b1/b2 Endpoints of arc around b

ang Angle of slot centerline

obm Old blipmode setting, 0 or 1

r Radius of arcs

w Width of slot |;

;以上为注释

(defun c:mslot (/ a a1 a2 ang b b1 b2 obm r w) ;line 1开始定义命令mslot (setq obm (getvar "blipmode")) ;line 2保存系统变量(控制点标记)设置 (initget 7) ;line 3，设置输入格式，后面的getreal只能且必须输入实数(setq w (getreal "\nWidth of slot: ")) ;line 4从命令行提示用户输入宽度参数，保存到变量w

(setq r (/ w 2)) ;line 5

(setvar "blipmode" 1) ;line 6设置系统变量，打开点标记 (initget

1) ;line 7设置输入格式

(setq a (getpoint "\nLocate first center: ")) ;line 8提示用户输入点a(命令行输入或屏幕选取)

(initget 1) ;line 9 设置输入格式

10

(setq b (getpoint a "\nLocate second center: ")) ;line 10提示用户输入点b (setvar "blipmode" 0) ;line 11设置系统变量，关闭点标记 (setq ang (angle a b)) ;line 12以下至line16计算点坐标

(setq a1 (polar a (- ang (/ pi 2)) r)) ;line 13

(setq a2 (polar a (+ ang (/ pi 2)) r)) ;line 14

(setq b1 (polar b (- ang (/ pi 2)) r)) ;line 15

(setq b2 (polar b (+ ang (/ pi 2)) r)) ;line 16

(setvar "cmdecho" 0) ;line 17设置系统变量，关闭回显 (command

".pline" a1 b1 "A" b2 "L" a2 "A" "CL") ;line 18绘制

(setvar "cmdecho" 1) ;line 19设置系统变量，打开回显 (setvar "blipmode" obm) ;line 20回复系统变量设置

有这行，mslot命令结束时会在命令行显示0，自定义的命令都(princ) ;line 21没

应以此函数结束

) ;line 22结束行，括号和第1行的第一个括号匹配。

该程序可分为五个部分:

注释部分:为程序作注释是个良好的习惯，程序第一部分为注释，内容为程序目的、变量说明等，单行注释以“;”开始，多行注释以“;|”开始，“|;”结束。函数头(行1):程序行1为函数头，定义函数的名称及局部变量保存系统设置(行2):程序行2保存系统变量设置，为后面恢复设置用输入参数(行3-11) 计算(行12-16)

绘图(行17-19)

恢复系统设置(行20-22)

11