;;;==========================================================================
;|      (JS-STR-FG STR FUNX)
  函数：分割公式字符串
  例子：	_$  (JS-str-fg "1+2*3-(10/5-1)" "+")
		  ("1" "+" "2*3-(10/5-1)")
		_$  (JS-str-fg "1+2*3-(10/5-1)" "-")
		  ("1+2*3" "-" "(10/5-1)")
  日期：zml84 于 2007-07-26
  |;
(defun JS-STR-FG (STR FUNX / LST I N TMP)
    ;;初始化
    (setq LST '()
	  I   0 ;_ 变量 I 为进入括号的层数（0：括号外）
	  N   1
	  TMP ""
    )
    ;;循环分解字符
    (repeat (strlen STR)
	(setq STRI (substr STR N 1))
	(cond
	    ;;分支一：在括号外部 遇到 运算符
	    ((and (= I 0)
		  (= STRI FUNX)
	     )
	     (if (/= TMP "")
		 (setq LST (cons TMP LST)
		       TMP ""
		 )
	     )
	     (setq LST (cons FUNX LST))
	    )
	    ;;
	    (t
	     (setq TMP (strcat TMP STRI))
	     (cond
		 ((= STRI "(")
		  (setq I (1+ I))
		 )
		 ((= STRI ")")
		  (setq I (1- I))
		 )
	     )
	    )
	) ;_ 结束 cond
	(setq N (1+ N))
    ) ;_ 结束 repeat
    (if	(/= TMP "")
	(setq LST (cons TMP LST))
    )

;;;    ;;特殊处理
;;;    (cond
;;;	;;若原子间无操作
;;;	((= funx "*")
;;;	 
;;;	 )
;;;
;;;
;;;
;;;
;;;	)
    ;;列表倒置
    (reverse LST)
) ;_ 结束 defun
;;;=====================================================================
;;;  函数功能：数学表达式计算
;;;  日期：zml84 于 2007-07-26
(defun JS (STR / LST JG)
    ;;替换括号
    ;;(setq STR (vl-string-translate "（）[]{}＋－×÷" "()()()+-*/" STR))
    (setq STR (vl-string-translate "[]{}" "()()" STR))
    (cond
	;;分支一：出错
	((wcmatch STR "错误*")
	 (setq JG STR)
	)
	;;加法	
	((and (setq LST (JS-STR-FG STR "+"))
	      (member "+" LST)
	 )
	 (setq JG 0)
	 (foreach STRI LST
	     (if (= STRI "+")
		 ()
		 (setq JG (+ JG (JS STRI)))
	     )
	 )
	)
	;;减法
	((and (setq LST (JS-STR-FG STR "-"))
	      (member "-" LST)
	 )
	 (if (= (car LST) "-")
	     (setq JG 0)
	     (setq JG (JS (car LST)))
	 )
	 (foreach STRI (cdr LST)
	     (if (= STRI "-")
		 ()
		 (setq JG (- JG (JS STRI)))
	     )
	 )
	)
	;;乘法
	((and (setq LST (JS-STR-FG STR "*"))
	      (member "*" LST)
	 )
	 (setq JG 1)
	 (foreach STRI LST
	     (if (= STRI "*")
		 ()
		 (setq JG (* JG (JS STRI)))
	     )
	 )
	)
	;;除法
	((and (setq LST (JS-STR-FG STR "/"))
	      (member "/" LST)
	 )
	 (if (= (car LST) "/")
	     (setq JG 1.0)
	     (setq JG (* (JS (car LST)) 1.0))
	 )
	 (foreach STRI (cdr LST)
	     (if (= STRI "/")
		 ()
		 (setq JG (/ JG (JS STRI)))
	     )
	 )
	)
	;;乘方
	((and (setq LST (JS-STR-FG STR "^"))
	      (member "^" LST)
	 )
	 (setq JG (JS (car LST)))
	 (foreach STRI (cdr LST)
	     (if (= STRI "^")
		 ()
		 (setq JG (expt JG (JS STRI)))
	     )
	 )
	)
	;;括号
	((and (wcmatch STR "(*")
	      (wcmatch STR "*)")
	 )
	 (setq JG (JS (substr STR 2 (- (strlen STR) 2))))
	)
	;;符号、数字
	(t
	 (if (setq JG (eval (read STR)))
	     ()
	     (setq JG 0.0)
	 )
	)
    )
    JG
) ;_结束 defun js
;;;=====================================================================
;;  (princ (JS "1+4+5*2+(5+5)/2+[(6+6)/2+(5+5)/2]"))
;;测试：
(defun C:TT (/ STR)
    (while (/= (setq STR (getstring "\n请输入算术表达式: "))
	       ""
	   )
	(princ (JS STR))
    )
    (princ)
)