yang686526

数字运算
www.dimcax.com
数字运算
;;;
;;; ------------
;;; * 数字运算 *
;;; ------------
;;; +、-、*、/ 保留原有数字，而且+与*可多选。
;;; +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)
)
d