数字运算

108848

;;;
;;; ------------
;;; * 数字运算 *
;;; ------------
;;; +、-、*、/ 保留原有数字，而且+与*可多选。
;;; +0、-0、*0、/0 改变原有数字
;;; ++、** 将所选文字增加（乘以）相同的量
;;; +- 按给定增量（缺剩值为1）递增。

;;; 注意：若为MTEXT，需将其打散。
;;; 有效位数取统缺省值,结果字高为第一个所选数字的字高。
;;;

;;;
;;; ADDITION CALCULATION
;;;
(defun C:+ (/ ns s n i e eb ds i ss pt bool th blio cmdo)
(setq blio (getvar "blipmode"))
(setq cmdo (getvar "cmdecho"))
(setvar "blipmode" 0)
(setvar "cmdecho" 0)
(setq bool "T")
(princ "\nPlease choose numbers:")
(setq ns (ssget))
(if ns
(progn
(setq s 0.0)
(setq i 0)
(setq n (sslength ns))
(while (< i n)
(setq e (ssname ns i))
(setq eb (entget e))
(if (= "TEXT" (cdr (assoc 0 eb)))
(progn
(if bool
(progn
(setq th (cdr (assoc 40 eb)))
(setq bool nil)
)
)
(setq ds (atof (cdr (assoc 1 eb))))
(setq s (+ s ds))
)
)
(setq i (1+ i))
)
(setq ss (rtos s 2 3))
(setq pt (getpoint "\nInsert point of result:"))
(command "text" pt th 0 ss)

)
)
(setvar "blipmode" blio)
(setvar "cmdecho" cmdo)
(princ)
)

;;;
;;; SUBTRACTION CALCULATION
;;;
(defun C:- (/ ae be a b c ss pt th blio cmdo)
(setq blio (getvar "blipmode"))
(setq cmdo (getvar "cmdecho"))
(setvar "blipmode" 0)
(setvar "cmdecho" 0)
(setq ae (car (entsel "\nPick number from which being subtracted:")))
(setq be (car (entsel "\nPick subtract number:")))
(if (and ae be)
(if (and (= "TEXT" (cdr (assoc 0 (entget ae))))
(= "TEXT" (cdr (assoc 0 (entget be))))
)
(progn
(setq th (cdr (assoc 40 (entget ae))))
(setq a (atof (cdr (assoc 1 (entget ae)))))
(setq b (atof (cdr (assoc 1 (entget be)))))
(setq c (- a b))
(setq ss (rtos c 2 3))
(setq pt (getpoint "\nInsert point of result:"))
(command "text" pt th 0 ss)
)
)
)
(setvar "blipmode" blio)
(setvar "cmdecho" cmdo)
(princ)
)

;;;
;;; MULTIPLICATION CALCULATION
;;;
(defun C:* (/ ns s i n e eb ds i ss pt th bool blio cmdo)
(setq blio (getvar "blipmode"))
(setq cmdo (getvar "cmdecho"))
(setvar "blipmode" 0)
(setvar "cmdecho" 0)
(setq bool "T")
(princ "\nPlease choose numbers:")
(setq ns (ssget))
(if ns
(progn
(setq i 0
s 1.0
) ;s--result,orign value is 1.0
(setq n (sslength ns))
(while (< i n)
(setq e (ssname ns i))
(setq eb (entget e))
(if (= "TEXT" (cdr (assoc 0 eb)))
(progn
(if bool
(progn
(setq th (cdr (assoc 40 eb)))
(setq bool nil)
)
)
(setq ds (atof (cdr (assoc 1 eb))))
(setq s (* s ds))
)
)
(setq i (1+ i))
)
(setq ss (rtos s 2))
(setq pt (getpoint "\nInsert point of result:"))
(command "text" pt th 0 ss)
)
)
(setvar "blipmode" blio)
(setvar "cmdecho" cmdo)
(princ)
)

;;;
;;; DIVIDING CALCULATION
;;;

(defun C:/ (/ ae be a b ss th pt)
(setq blio (getvar "blipmode"))
(setq cmdo (getvar "cmdecho"))
(setvar "blipmode" 0)
(setvar "cmdecho" 0)
(setq ae (car (entsel "\nPick being divided number:")))
(setq be (car (entsel "\nPick divide number:")))
(if (and ae be)
(if (and (= "TEXT" (cdr (assoc 0 (entget ae))))
(= "TEXT" (cdr (assoc 0 (entget be))))
)
(progn
(setq th (cdr (assoc 40 (entget ae))))
(setq a (atof (cdr (assoc 1 (entget ae)))))
(setq b (atof (cdr (assoc 1 (entget be)))))
(if (> (abs b) 0.0000001)
(setq ss (rtos (/ a b) 2))
(setq ss "ERROR")
)
(setq pt (getpoint "\nInsert point of result:"))
(command "text" pt th 0 ss)
)
)
)
(setvar "blipmode" blio)
(setvar "cmdecho" cmdo)
(princ)
)

;;;
;;; ADDITION CALCULATION (changed)
;;;
(defun C:+0 (/ ae be a b c ss al)
(setq blio (getvar "blipmode"))
(setq cmdo (getvar "cmdecho"))
(setvar "blipmode" 0)
(setvar "cmdecho" 0)
(command "redraw")
(setq ae (car (entsel "\nPick number which being added:")))
(setq be (car (entsel "\nPick adding number:")))
(if (and ae be)
(if (and (= "TEXT" (cdr (assoc 0 (entget ae))))
(= "TEXT" (cdr (assoc 0 (entget be))))
)
(progn
(setq a (atof (cdr (assoc 1 (entget ae)))))
(setq b (atof (cdr (assoc 1 (entget be)))))
(setq c (+ a b))
(setq ss (rtos c 2))
(setq al (entget ae))
(setq al (subst (cons 1 ss) (assoc 1 al) al))
(entmod al)
)
)
)
(setvar "blipmode" blio)
(setvar "cmdecho" cmdo)
(princ)
)

;;;
;;; SUBTRACTION CALCULATION (changed)
;;;

(defun C:-0 (/ ae be a b c ss al)
(setq blio (getvar "blipmode"))
(setq cmdo (getvar "cmdecho"))
(setvar "blipmode" 0)
(setvar "cmdecho" 0)
(command "redraw")
(setq ae (car (entsel "\nPick number from which being subtracted:")))
(setq be (car (entsel "\nPick subtract number:")))
(if (and ae be)
(if (and (= "TEXT" (cdr (assoc 0 (entget ae))))
(= "TEXT" (cdr (assoc 0 (entget be))))
)
(progn
(setq a (atof (cdr (assoc 1 (entget ae)))))
(setq b (atof (cdr (assoc 1 (entget be)))))
(setq c (- a b))
(setq ss (rtos c 2))
(setq al (entget ae))
(setq al (subst (cons 1 ss) (assoc 1 al) al))
(entmod al)
)
)
)
(setvar "blipmode" blio)
(setvar "cmdecho" cmdo)
(princ)
)

;;;
;;; MULTIPLICATION CALCULATION (changed)
;;;

(defun C:*0 (/ ae be a b c ss al)
(setq blio (getvar "blipmode"))
(setq cmdo (getvar "cmdecho"))
(setvar "blipmode" 0)
(setvar "cmdecho" 0)
(command "redraw")
(setq ae (car (entsel "\nPick being multiplied number:")))
(setq be (car (entsel "\nPick multiply number:")))
(if (and ae be)
(if (and (= "TEXT" (cdr (assoc 0 (entget ae))))
(= "TEXT" (cdr (assoc 0 (entget be))))
)
(progn
(setq a (atof (cdr (assoc 1 (entget ae)))))
(setq b (atof (cdr (assoc 1 (entget be)))))
(setq c (* a b))
(setq ss (rtos c 2))
(setq al (entget ae))
(setq al (subst (cons 1 ss) (assoc 1 al) al))
(entmod al)
)
)
)
(setvar "blipmode" blio)
(setvar "cmdecho" cmdo)
(princ)
)

;;;
;;; DIVIDING CALCULATION (changed)
;;;
(defun C:/0 (/ ae bd a b c ss al)
(setq blio (getvar "blipmode"))
(setq cmdo (getvar "cmdecho"))
(setvar "blipmode" 0)
(setvar "cmdecho" 0)
(command "redraw")
(setq ae (car (entsel "\nPick being divided number:")))
(setq be (car (entsel "\nPick divide number:")))
(if (and ae be)
(if (and (= "TEXT" (cdr (assoc 0 (entget ae))))
(= "TEXT" (cdr (assoc 0 (entget be))))
)
(progn
(setq a (atof (cdr (assoc 1 (entget ae)))))
(setq b (atof (cdr (assoc 1 (entget be)))))
(if (> (abs b) 0.0000001)
(progn
(setq ss (rtos (/ a b) 2))
(setq al (entget ae))
(setq al (subst (cons 1 ss) (assoc 1 al) al))
(entmod al)
)
(alert "ERROR")
)
)
)
)
(setvar "blipmode" blio)
(setvar "cmdecho" cmdo)
(princ)
)

;;;------------------------------------------------
;;;
;;; subroutine for ADM and MUM
;;;
(defun MUL_CHANGE (cal / s b1 ns s ss n i ae a b c al blio cmdo)
;;cal is "+" or "*"
(setq blio (getvar "blipmode"))
(setq cmdo (getvar "cmdecho"))
(setvar "blipmode" 0)
(setvar "cmdecho" 0)
(command "undo" "begin")
(if (= cal "+")
(setq s "Increase" b1 0.0)
(setq s "Multiply" b1 1.0)
)
(princ "\nPlease choose numbers:")
(setq ns (ssget))
(if ns
(progn
(setq b (getreal (strcat "\n" s " valve <" (rtos b1 2 1) ">:")))
(if (/= (type b) 'REAL)
(setq b b1)
)
(setq i 0)
(setq n (sslength ns))
(while (< i n)
(setq ae (ssname ns i))
(if (= "TEXT" (cdr (assoc 0 (entget ae))))
(progn
(setq a (atof (cdr (assoc 1 (entget ae)))))
(if (= cal "+")
(setq c (+ a b))
(setq c (* a b))
)
(setq ss (rtos c 2))
(setq al (entget ae))
(setq al (subst (cons 1 ss) (assoc 1 al) al))
(entmod al)
)
)
(setq i (1+ i))
)
)
)
(command "undo" "end")
(setvar "blipmode" blio)
(setvar "cmdecho" cmdo)
) ;end defun

;;;
;;; ADD MULTI-NUMBER and CHANGE THEM
;;;
(defun C:++ ()
(mul_change "+")
(princ)
)

;;;
;;; MULTIPLY MULTI-NUMBER and CHANGE THEM
;;;
(defun C:** ()
(mul_change "*")
(princ)
)

;;;------------------------------------------------

;;;------------------------------------------------
;;;
;;; INCREASE CALCULATION
;;;
(defun C:+- (/ blio cmdo d ae a i ab al)
(setq blio (getvar "blipmode"))
(setq cmdo (getvar "cmdecho"))
(setvar "blipmode" 0)
(setvar "cmdecho" 0)
(setq d (getreal "\nInput increase quantum <1>:"))
(if (/= (type d) 'REAL)
(setq d 1)
)
(setq ae (car (entsel "\nPick number to change:")))
(setq a (atof (cdr (assoc 1 (entget ae)))))
(setq i 1)
(while ae
(if (= "TEXT" (cdr (assoc 0 (entget ae))))
(progn
(if (= i 1)
(setq a (- a d))
)
(setq ab (rtos (setq a (+ a d)) 2))
(setq al (entget ae))
(setq al (subst (cons 1 ab) (assoc 1 al) al))
(entmod al)
)
)
(setq ae (car (entsel "\nPick number to change:")))
(setq i (1+ i))
)
(setvar "blipmode" blio)
(setvar "cmdecho" cmdo)
(princ)
)

(princ "\n\tc:INC loaded. start command with INC.")
(princ)

求平均值：
(defun C:-+( / sum n tum x ss2 ssna ss1)
(setq ss1 (ssget '((0 . "text"))))
(setq ssna(sslength ss1))
(princ (strcat "\n 共选择了" (itoa ssna) "个数据文本。"))
(setq sum 0.0 n 0 tum 0)
(while (< n ssna)
(setq ss2 (assoc 1 (entget (ssname ss1 n))))
(setq x (atof (cdr ss2)))
(setq tum (+ tum (* x x)))
(setq sum (+ sum x) n (1+ n))
)

(setq afcx (sqrt (/ (- tum (* n (/ sum n)(/ sum n))) (- n 1))))

(princ (strcat "\n 样本数=" (rtos n) " 总和=" (rtos sum 2 4) " 平均值=" (rtos (/ sum ssna) 2 4) ))
(princ (strcat " 平方和=" (rtos tum 2 4) " 标准差('n-1'方法)=" (rtos afcx 2 4) ))
(princ)
)

zfsaaa

加载时提示c:INC loaded. start command with INC.; 错误: 输入的列表有缺陷，是不是哪里有问题

coco25825

有批量求乘，批量求除的命令吗

ljttjl

http://ljttjl.ys168.com   20091020算数表达式文字求值

zhynt

这种对字符串表达式的计算用geomcal.arx里的 cal 函数最好了。

zhaozwf

超棒，这个程序，呵呵，收藏了，

tfanghui

计算出来的数据是横着的，