明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1420|回复: 0

如何用VBA改写LISP程序?

[复制链接]
发表于 2006-1-22 12:58:00 | 显示全部楼层 |阅读模式

各位大虾好,本人原来使用LISP写段子,现在改学VBA了。但是对VBA的函数使用还是很不熟悉,现有一LISP写的抛物线程序,改了几次都不成功,想请哪位大虾帮忙改写下,当做指导吾等后学,不胜感激!

(defun C:par( / pt1 pt2 pt3 pt_a pt_b dx x y x_start x_end num_pts a b c
                ret_list ocmd oblip sset ent1)

 (setq ocmd (getvar "cmdecho") oblip (getvar "blipmode"))
 (setvar "cmdecho" 0)
 (setvar "blipmode" 0)

 (initget 7)
 (setq pt1 (getpoint "\nSelect first point on parabola:"))
 (setq pt2 (getpoint "\nSelect second point on parabola:"))
 (setq pt3 (getpoint "\nSelect third point on parabola:"))

 (setq num_pts (getint "\nNumber of points to use:"))

 (setq ret_list (get_coeff pt1 pt2 pt3))

 (setq a       (nth 0 ret_list)
       b       (nth 1 ret_list)
       c       (nth 2 ret_list)
       x_start (nth 3 ret_list)
       x_end   (nth 4 ret_list)
 )

 (setq dx (/ (- x_end x_start) (float num_pts) ))

 (setq x x_start)
 (setq y (fpoly a b c x))
 (setq pt_a (list x y 0.0))
 (setq x (+ x_start dx))

 (setq sset(ssadd))

 (repeat num_pts
    (setq y (fpoly a b c x))
    (setq pt_b (list x y 0.0))
    (command "pline" pt_a pt_b "")
    (setq sset (ssadd (entlast) sset))
    (setq pt_a pt_b x (+ x dx) )
 )

 (command "pedit" "L" "J" sset "" "")

 (setvar "cmdecho" ocmd)
 (setvar "blipmode" oblip)

)

(defun get_coeff(pt1 pt2 pt3 / x1 x2 y1 y2 x3 y3 x1sq x2sq x3sq
                               a b c ret_list)

(setq x1 (car pt1) y1 (cadr pt1) x1sq (* x1 x1) )
(setq x2 (car pt2) y2 (cadr pt2) x2sq (* x2 x2) )
(setq x3 (car pt3) y3 (cadr pt3) x3sq (* x3 x3) )

(setq x_start (min x1 x2 x3) x_end (max x1 x2 x3))

(setq det1 (det x1sq x2sq x3sq x1 x2 x3 1.0 1.0 1.0))

(setq a(/ (det y1 y2 y3 x1 x2 x3 1.0 1.0 1.0)       det1))
(setq b(/ (det x1sq x2sq x3sq y1 y2 y3 1.0 1.0 1.0) det1))
(setq c(/ (det x1sq x2sq x3sq x1 x2 x3 y1  y2  y3 ) det1))

(setq ret_list (list a b c x_start x_end))

)

(defun fpoly(a b c x / y)

(setq y (+ (* a x x) (* b x) c) )
)

(defun det(a1 a2 a3 b1 b2 b3 c1 c2 c3 / ret_val)

  (setq ret_val (+
                   (* a1 (- (* b2 c3) (* b3 c2) ))
                   (* b1 (- (* c2 a3) (* c3 a2) ))
                   (* c1 (- (* a2 b3) (* a3 b2) ))
                )
  )
)

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-11-27 06:21 , Processed in 0.141639 second(s), 25 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表