[LISP程序]：add框选加法程序

dicad_pro

add

ksblk

有说明吗？

zhuquanmao

谢谢楼主提供 程序很是不错

;;;
;;; ------------
;;; * 数字运算 *
;;; ------------
;;; ADD、SUB、MUL、DIV 保留原有数字，而且ADD与MUL可多选。
;;; AD1、SU1、MU1、DI1 改变原有数字
;;; ADM、MUM 将所选文字增加（乘以）相同的量
;;; INC 按给定增量（缺剩值为1）递增。

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

;;;
;;; ADDITION CALCULATION
;;;
(defun C:ADD (/ 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:SUB (/ 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:MUL (/ 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:DIV (/ 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:AD1 (/ 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:SU1 (/ 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:MU1 (/ 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:DI1 (/ 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:ADM ()
  (mul_change "+")
  (princ)
)

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

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

;;;------------------------------------------------
;;;
;;; INCREASE CALCULATION
;;;
(defun C:INC (/ 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)