cad表达式数学计算插件，在论坛已经有的程序程序上如何增加函数
本帖最后由 664571221 于 2018-8-14 18:39 编辑有时候cad中有一些要计算结果的计算式，比如：2+6-2^2*56 等，找了几个插件，还只有源泉建筑插件能够计算数学表达式，并且很方便，可如果光为这功能安装一个很多功能的源泉实在有些不划算。
论坛已经有的代码可能是高飞鸟的
;;;=============================================================
;;; 函数目的: 字符表达式转为函数，主要用于多次调用时提升速度
;;; 输入: expr--字符表达式,sFunc--函数名,sArg--参数符号列表
;;; 输出: 定义函数，并返回其名
;;; 例子: (CAL:Expr2Func "sin(x)+20*y" 'test '(x y))
;;; 结果: 定义了一个名为test的函数，参数符号为x y
;;; 注意: 除法区分整数和浮点数，譬如"2/3"和"2/3.0"结果不同；
;;; 可用自定义函数，前提是首先要加载；
;;; 可用科学计算法，但应满足LISP中的语法。建议用括号；
;;; 表达式应满足语法要求，小数和乘号不能按省略写法。
;;;=============================================================
(defun CAL:Expr2Func (expr sFunc sArgs / lst)
(setq lst (CAL:Separate expr)) ;先按照括号空格和运算符分离字符
(setq lst (CAL:Operators lst '((^ . expt)) ())) ;乘方（幂）最优先
(setq lst (CAL:Operators lst '((* . *) (/ . /) (% . rem)) ()));其次乘除和求模运算
(setq lst (CAL:Operators lst '((+ . +) (- . -)) ())) ;最后处理加减法运算
(eval (cons 'defun (cons sFunc (cons sArgs lst)))) ;表达成函数
)
;;;=============================================================
;;; 函数目的: 字符表达式求值
;;; 输入: expr--字符表达式
;;; 输出: 计算表达式的结果
;;; 例子: (CAL:Expr2Value "sin(1)+20*2")
;;; 结果: 40.8415
;;;=============================================================
(defun CAL:Expr2Value (expr / lst)
(setq lst (CAL:Separate expr)) ;先按照括号空格和运算符分离字符
(setq lst (CAL:Operators lst '((^ . expt)) ())) ;乘方（幂）最优先
(setq lst (CAL:Operators lst '((* . *) (/ . /) (% . rem)) ()));其次乘除和求模运算
(setq lst (CAL:Operators lst '((+ . +) (- . -)) ())) ;最后处理加减法运算
(eval (car lst)) ;求值
)
;;;=============================================================
;;; 函数目的: 先分离出函数和+-*/%^运算符，其余均视作变量或数值，
;;; 并简单检查括号匹配。
;;; 输入: expr--字符表达式
;;; 输出: 函数（包括运算符）和变量及数值的列表
;;;=============================================================
(defun CAL:Separate (expr / CHAR FUNS LASTCHAR LST Temp LBRACKET RBRACKET next)
(setq expr (vl-string-translate "{[]}\t\n," "(()) " expr));替换{[]}\t\n,字符
(setq expr (strcase expr t)) ;全部转为小写
(setq funs '("+" "-" "*" "/" "^" "%" )) ;按照基本运算符分割字符
(setq Temp "")
(setq lst "(")
(setq Lbracket 0) ;左括号计数器
(setq Rbracket 0) ;右括号计数器
(while (/= expr "")
(setq char (substr expr 1 1)) ;字符串的第一个字符
(setq next (substr expr 2 1)) ;字符串的第二个字符
(if (or (= char "(")
(= char ")") ;括号一定是分隔符
(and (= char " ") (/= next "(") (/= next " ")) ;如果不是连续的空格符
(and (member char funs) ;根据运算符进行分割
(not (CAL:isScientific temp lastchar char)) ;忽略科学计数法
)
)
(progn
(if (CAL:IsFunction (Read temp)) ;如果为普通函数
(setq lst (strcat lst "(" Temp " " ) ;则把括号移至函数符号前
Lbracket (1+ Lbracket) ;左括号计数器加1
)
(progn
(and (= char "(") (setq Lbracket (1+ Lbracket))) ;左括号计数器加1
(and (= char ")") (setq Rbracket (1+ Rbracket))) ;右括号计数器加1
(setq lst (strcat lst Temp " " char " "))
)
)
(setq Temp "") ;如果是函数或者括号空格之类，则在此处重新开始
)
(setq Temp (strcat Temp char)) ;否则连取这个字符
)
(setq expr (substr expr 2)) ;字符串剩下的字符
(setq lastchar char)
)
(if (/= Lbracket Rbracket) ;如果括号不平衡
(alert "括号不匹配(Mismatched Brackets)!") ;警告信息
(read (strcat lst Temp ")")) ;否则转为表
)
)
;;;=============================================================
;;; 函数目的: 分析+-*/%^运算符，并组合到表中
;;; 输入: lst-已分割的表,funs-待分析的运算符,Recursive-是否递归
;;; 输出: 函数（包括运算符）和变量及数值的列表
;;;=============================================================
(defun CAL:Operators (lst funs Recursive / fun L n)
(foreach a lst
(if (listp a)
(setq a (CAL:Operators a funs T)) ;如果元素为表，则递归进去
)
(if (setq fun (cdr (assoc (car L) funs))) ;前一个符号为+-*/%^运算符
(if (or (null (setq n (cadr L))) ;前前一个符号为空
(and (VL-SYMBOLP n) (CAL:IsFunction n)) ;或者是函数符号
)
(setq L (cons (list fun a) (cdr L))) ;无须交换位置
(setq L (cons (list fun n a) (cddr L))) ;交换运算符和操作数位置
)
(setq L (cons a L)) ;其他的不做改变
)
)
(setq n (car L))
(if (and Recursive (not (cadr L)) (or (listp n) (numberp n))) ;如果是递归的,而且只有一个元素，且这个元素为表或者数字
n ;那么就只取这个元素，以防止多余括号出现
(reverse L) ;cons运算后的反转表列
)
)
;;;=============================================================
;;; 函数目的: 判断一个符号是不是普通函数（内部函数或自定义函数）
;;;=============================================================
(defun CAL:IsFunction (n)
(setq n (type (eval n)))
(or (= n 'SUBR) (= n 'USUBR))
)
;;;=============================================================
;;; 函数目的: 检测一个字符串是否是科学计数法(是否有更好方法?)
;;;=============================================================
(defun CAL:isScientific (temp lastchar char)
(and (= lastchar "e") (numberp (read (strcat temp char "0"))))
)
;|
;;; 例子:
;;; (CAL:Separate "(sin(-x)-cos(-x+(1+8*(2/7))+2^4-5))*0.5-0.5e-20+20*cos(x)+20")
;;; 结果: ((SIN - X) - (COS - X + (1 + 8 * (2 / 7)) + 2 ^ 4 - 5))
;;; (CAL:Expr2Func "(sin(+x)-cos(-x+(1+8*(2/7))+(2^4)-5))*0.5-0.5e-20+20*cos(x)+20" 'test '(x))
;;; 结果: 定义了一个名为test的函数，参数符号为x
;;; (CAL:Expr2Value "(sin(+0.5)-cos(-pi+(1+8*(2/7))+(2^4)-5))*0.5-0.5e-20+20*cos(pi/2)+20")
;;; 结果: 20.6616
;;; 以下是关于这个程序的其他方法：
;;; 方法一:用cal函数计算
;;; 如:(cal "1+4+5*2+(5+5)/2+((6+6)/2+(5+5)/2)")
;;; 优点：CAD内置函数。
;;; 缺点：这个函数要求先要加载cal函数.并且三角函数会自动把变量或者数值理解为角度。
;;; 方法二:wcs脚本语言法,无痕提出的一种方法
;;; (setq wcs (vla-GetInterfaceObject (vlax-get-acad-object) "ScriptControl"))
;;; (vlax-put-property wcs "language" "vbs")
;;; (vla-eval wcs "1+4+5*2+(5+5)/2+((6+6)/2+(5+5)/2)");返回 ->31.0
;;; 优点：能按照vb的语法直接计算。
;;; 缺点：难以定义表达式为函数，不能利用自定义函数，在64位CAD上此法行不通，因为不能创建脚本对象。
;;; 下面例子为在CAD中绘制函数图像
(defun c:test1()
(setq expr (getstring "\n请输入表达式:"))
(initget 1)
(setq a (getreal "\n上届:"))
(initget 1)
(setq b (getreal "\n下届:"))
(if (CAL:EXPR2FUNCexpr 'test '(x))
(progn
(setq d (/ (- b a) 1000.0))
(setq x a)
(setq pts nil)
(repeat 1000
(setq x (+ x d))
(setq y (test x))
(setq pts (cons (list x y 0) pts))
)
(setq pts (reverse pts))
(setq e (Entmake (list '(0 . "POLYLINE") '(70 . 8))))
(foreach p pts
(entmake (list '(0 . "VERTEX") '(70 . 32) (cons 10 p)))
)
(entmake '((0 . "SEQEND")))
(entlast)
)
)
)
;;; 在CAD中绘制参数曲线
;;; x=a*(2*cos(t)-cos(2*t))
;;; y=a*(2*sin(t)-sin(2*t))
(defun c:test2 ()
(setq expr1 "3*(2*cos(k)-cos(2*k))")
(setq expr2 "3*(2*sin(k)-sin(2*k))")
(setq a 0)
(setq b (+ pi pi))
(CAL:EXPR2FUNC expr1 'fx '(k))
(CAL:EXPR2FUNC expr2 'fy '(k))
(setq d (/ (- b a) 360))
(setq k a)
(setq pts nil)
(repeat 360
(setq k (+ k d))
(setq x (fx k))
(setq y (fy k))
(setq pts (cons (list x y 0) pts))
)
(setq pts (reverse pts))
(setq e (Entmake (list '(0 . "POLYLINE") '(70 . 9))))
(foreach p pts
(entmake (list '(0 . "VERTEX") '(70 . 32) (cons 10 p)))
)
(entmake '((0 . "SEQEND")))
(entlast)
)
;;; 定义为函数后，明显速度快多了
(defun c:test3()
(setq str1 "(sin(+x)-cos(-x+(1+8*(2/7.0))+(2^4)-5))*0.5-0.5e-20+20*cos(x)+20")
(setq str2 "(sin(r2d(x))-cos(r2d(-x+(1+8*(2/7.0))+(2^4)-5)))*0.5-0.5e-20+20*cos(r2d(x))+20")
(CAL:Expr2Func str1 'f1 '(x))
(setq x 12)
(uti:bench 1000
(list
(cons 'f1 '(12))
(cons 'CAL:Expr2Value (list str1))
(cons 'cal (list str2))
)
)
)
;;|;
页:
[1]