如何用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> ret_list ocmd oblip sset ent1)</P>
<P> (setq ocmd (getvar "cmdecho") oblip (getvar "blipmode"))<BR> (setvar "cmdecho" 0)<BR> (setvar "blipmode" 0)</P>
<P> (initget 7)<BR> (setq pt1 (getpoint "\nSelect first point on parabola:"))<BR> (setq pt2 (getpoint "\nSelect second point on parabola:"))<BR> (setq pt3 (getpoint "\nSelect third point on parabola:"))</P>
<P> (setq num_pts (getint "\nNumber of points to use:"))</P>
<P> (setq ret_list (get_coeff pt1 pt2 pt3))</P>
<P> (setq a (nth 0 ret_list)<BR> b (nth 1 ret_list)<BR> c (nth 2 ret_list)<BR> x_start (nth 3 ret_list)<BR> x_end (nth 4 ret_list)<BR> )</P>
<P> (setq dx (/ (- x_end x_start) (float num_pts) ))</P>
<P> (setq x x_start)<BR> (setq y (fpoly a b c x))<BR> (setq pt_a (list x y 0.0))<BR> (setq x (+ x_start dx))</P>
<P> (setq sset(ssadd))</P>
<P> (repeat num_pts<BR> (setq y (fpoly a b c x))<BR> (setq pt_b (list x y 0.0))<BR> (command "pline" pt_a pt_b "")<BR> (setq sset (ssadd (entlast) sset))<BR> (setq pt_a pt_b x (+ x dx) )<BR> )</P>
<P> (command "pedit" "L" "J" sset "" "")</P>
<P> (setvar "cmdecho" ocmd)<BR> (setvar "blipmode" oblip)</P>
<P>)</P>
<P>(defun get_coeff(pt1 pt2 pt3 / x1 x2 y1 y2 x3 y3 x1sq x2sq x3sq<BR> 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) 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 y2 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> (setq ret_val (+ <BR> (* a1 (- (* b2 c3) (* b3 c2) ))<BR> (* b1 (- (* c2 a3) (* c3 a2) ))<BR> (* c1 (- (* a2 b3) (* a3 b2) ))<BR> )<BR> )<BR>)<BR></P>
页:
[1]