worinima 发表于 2006-1-22 12:58:00

如何用VBA改写LISP程序?

<P>各位大虾好,本人原来使用LISP写段子,现在改学VBA了。但是对VBA的函数使用还是很不熟悉,现有一LISP写的抛物线程序,改了几次都不成功,想请哪位大虾帮忙改写下,当做指导吾等后学,不胜感激!</P>
<P>(defun C:par( / pt1 pt2 pt3 pt_a pt_b dx x y x_start x_end num_pts a b c<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ret_list ocmd oblip sset ent1)</P>
<P>&nbsp;(setq ocmd (getvar "cmdecho") oblip (getvar "blipmode"))<BR>&nbsp;(setvar "cmdecho" 0)<BR>&nbsp;(setvar "blipmode" 0)</P>
<P>&nbsp;(initget 7)<BR>&nbsp;(setq pt1 (getpoint "\nSelect first point on parabola:"))<BR>&nbsp;(setq pt2 (getpoint "\nSelect second point on parabola:"))<BR>&nbsp;(setq pt3 (getpoint "\nSelect third point on parabola:"))</P>
<P>&nbsp;(setq num_pts (getint "\nNumber of points to use:"))</P>
<P>&nbsp;(setq ret_list (get_coeff pt1 pt2 pt3))</P>
<P>&nbsp;(setq a&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (nth 0 ret_list)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; b&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (nth 1 ret_list)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; c&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (nth 2 ret_list)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; x_start (nth 3 ret_list)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; x_end&nbsp;&nbsp; (nth 4 ret_list)<BR>&nbsp;)</P>
<P>&nbsp;(setq dx (/ (- x_end x_start) (float num_pts) ))</P>
<P>&nbsp;(setq x x_start)<BR>&nbsp;(setq y (fpoly a b c x))<BR>&nbsp;(setq pt_a (list x y 0.0))<BR>&nbsp;(setq x (+ x_start dx))</P>
<P>&nbsp;(setq sset(ssadd))</P>
<P>&nbsp;(repeat num_pts<BR>&nbsp;&nbsp;&nbsp; (setq y (fpoly a b c x))<BR>&nbsp;&nbsp;&nbsp; (setq pt_b (list x y 0.0))<BR>&nbsp;&nbsp;&nbsp; (command "pline" pt_a pt_b "")<BR>&nbsp;&nbsp;&nbsp; (setq sset (ssadd (entlast) sset))<BR>&nbsp;&nbsp;&nbsp; (setq pt_a pt_b x (+ x dx) )<BR>&nbsp;)</P>
<P>&nbsp;(command "pedit" "L" "J" sset "" "")</P>
<P>&nbsp;(setvar "cmdecho" ocmd)<BR>&nbsp;(setvar "blipmode" oblip)</P>
<P>)</P>
<P>(defun get_coeff(pt1 pt2 pt3 / x1 x2 y1 y2 x3 y3 x1sq x2sq x3sq<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; a b c ret_list)</P>
<P>(setq x1 (car pt1) y1 (cadr pt1) x1sq (* x1 x1) )<BR>(setq x2 (car pt2) y2 (cadr pt2) x2sq (* x2 x2) )<BR>(setq x3 (car pt3) y3 (cadr pt3) x3sq (* x3 x3) )</P>
<P>(setq x_start (min x1 x2 x3) x_end (max x1 x2 x3))</P>
<P>(setq det1 (det x1sq x2sq x3sq x1 x2 x3 1.0 1.0 1.0))</P>
<P>(setq a(/ (det y1 y2 y3 x1 x2 x3 1.0 1.0 1.0)&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; det1))<BR>(setq b(/ (det x1sq x2sq x3sq y1 y2 y3 1.0 1.0 1.0) det1))<BR>(setq c(/ (det x1sq x2sq x3sq x1 x2 x3 y1&nbsp; y2&nbsp; y3 ) det1))</P>
<P>(setq ret_list (list a b c x_start x_end))</P>
<P>)</P>
<P>(defun fpoly(a b c x / y)</P>
<P>(setq y (+ (* a x x) (* b x) c) )<BR>)</P>
<P>(defun det(a1 a2 a3 b1 b2 b3 c1 c2 c3 / ret_val)</P>
<P>&nbsp; (setq ret_val (+ <BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (* a1 (- (* b2 c3) (* b3 c2) ))<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (* b1 (- (* c2 a3) (* c3 a2) ))<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (* c1 (- (* a2 b3) (* a3 b2) ))<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<BR>&nbsp; )<BR>)<BR></P>
页: [1]
查看完整版本: 如何用VBA改写LISP程序?