乘法和加法的LISP小程序

<FONT face=宋体>(defun c:accum(/ a n un index e1 e num tol)
(setq a (ssget) tol 1)
(setq n (sslength a))
(setq un (getvar "luprec"))
(setvar "luprec" 8)
(setq index (- n 1))
(repeat n
(setq e1 (entget (ssname a index)) index (1- index))
(setq e (assoc 0 e1))
(if(= "TEXT" (cdr e))
(progn
(setq num (atof (cdr (assoc 1 e1))))
(setq tol (* tol num))
)
)
)
(princ (strcat " 总数是 " (rtos tol)))
(setvar "luprec" un)
(princ)
)

(defun c:sum(/ a n un index e1 e num tol)
(setq a (ssget) tol 0.0)
(setq n (sslength a))
(setq un (getvar "luprec"))
(setvar "luprec" 8)
(setq index (- n 1))
(repeat n
(setq e1 (entget (ssname a index)) index (1- index))
(setq e (assoc 0 e1))
(if(= "TEXT" (cdr e))
(progn
(setq num (atof (cdr (assoc 1 e1))))
(setq tol (+ tol num))
)
)
)
(princ (strcat " 总数是 " (rtos tol)))
; (alert (strcat " 总数是 " (rtos tol)))
(setvar "luprec" un)
(princ)
)</FONT>

<>不错。</P>
<P>本人作了一些修改，就可以处理标注尺寸上的数据了。</P>
<P>(defun c:accum (/ a n un index e1 e num tol)
(setq a  (ssget)
    tol 1
)
(setq n (sslength a))
(setq un (getvar "luprec"))
(setvar "luprec" 8)
(setq index (- n 1))
(repeat n
  (setq e1  (entget (ssname a index))
     index (1- index)
  )</P>
<P>;********************* </P>
<P> (cond ((= (cdr (assoc 0 e1)) "TEXT")
      (setq tol (* tol (atof (cdr (assoc 1 e1))))))
     ((= (cdr (assoc 0 e1)) "DIMENSION")
      (if (/= (cdr (assoc 1 e1)) "")
       (setq tol (* tol (atof (cdr (assoc 1 e1)))))
       (setq tol (* tol (cdr (assoc 42 e1))))))
  )</P>
<P>;****************************
)
(princ (strcat " 总数是 " (rtos tol)))
(setvar "luprec" un)
(princ)
)</P>

<>感觉求和可能有点用处，比如不按比例绘图时核对尺寸链，所以将求和也改了一下。</P><P>(defun c:sum(/ a n un index e1 e num tol)
(setq a (ssget) tol 0.0)
(setq n (sslength a))
(setq un (getvar "luprec"))
(setvar "luprec" 8)
(setq index (- n 1))
(repeat n
(setq e1 (entget (ssname a index)) index (1- index))
(setq e (assoc 0 e1))
(cond ((= (cdr (assoc 0 e1)) "TEXT")
      (setq tol (+ tol (atof (cdr (assoc 1 e1))))))
     ((= (cdr (assoc 0 e1)) "DIMENSION")
      (if (/= (cdr (assoc 1 e1)) "")
       (setq tol (+ tol (atof (cdr (assoc 1 e1)))))
       (setq tol (+ tol (cdr (assoc 42 e1))))))
  )

)
(princ (strcat " 总和是：" (rtos tol)))
(setvar "luprec" un)
(princ)
)</P>[br][br]-----------------------------------------[br]奖励用户：原因：奖励  用户操作：金钱3，  操作者：2443725