LISP. Вычисление суммы чисел (например, в экспликации) (Страница 1 из 3)

;*** Сумма числовых значений ***
;*     Зуенко Виталий 2003г.   *
;* z-calc-text-value           *
(defun c:z-calc-text-value(/ nab i)
  (print "Выберите текстовые объекты среди которых будет произведененна калькуляция")
  (setq    nab (ssget '((-4 . "<OR")(0 . "TEXT")(0 . "MTEXT")(-4 . "OR>")))
    i   0)
  (while (/= (sslength nab) 0)
    (setq i (+ i
           (atof (vl-string-subst
               "."
               ","
               (cdr (assoc 1 (entget (ssname nab 0))))))))
    (ssdel (ssname nab 0) nab))
  (print (strcat "Сумма = " (rtos i)))
  (princ))

;*******SUMMA_N.LSP - Сумма числовых значений **********
;       Владимир Громов         Январь 2005 г.
;
(defun C:SUMMA_N ( / p1 p2 ss1 ssn1 n ss pp pp1 sum ssn e et text summa)
      (setvar "cmdecho" 0)
      (setq sum nil)
      (princ "\n Выбор объектов.")
      (setq p1 (getpoint " Первый угол рамки: "))
      (setq p2 (getcorner p1 "\n Второй угол рамки: "))
      (setq ss1 (ssget "_W" p1 p2))
  (if ss1
      (progn
      (setq ssn1 (sslength ss1) n 0)       ;Количество примитивов
      (setq ss (ssadd))                    ;Набор СОЗДАН (пустой пока)
         (repeat ssn1
           (setq pp (ssname ss1 n))        ;Имена примитивов
           (setq pp1 (entget pp))          ;Данные примитива с именем pp
           (cond
           ((= (cdr (assoc '0 pp1)) "TEXT") (ssadd pp ss) ;Набор ТЕКСТОВ
           ))
           (setq n (+ n 1))
         )
      (setq ssn (sslength ss) n 0)
         (repeat ssn
         (setq e (ssname ss n))
         (setq et (entget e))
         (setq text (cdr (assoc '1 et)))
         (setq text (vl-string-trim "%U" text))
         (princ "\n Число ")(princ n)(princ ": ")(princ text)
         (setq sum (cons (atof text) sum))
         (setq n (+ n 1))
         ); repeat
      (princ "\n Количество объектов: ") (princ ssn)
      (setq summa (apply '+ sum))
      (setq summa (strcat " Сумма чисел = " (rtos summa)))
      (princ summa) (alert summa)
      ); progn
      (progn
      (princ "\n Ничего не выбрано! ")
      (alert "\n Ничего не выбрано! ")
      ); progn
  ); if
  (princ)
)

(defun c:z-calc-text-value (/ value ent obj)
  (vl-load-com)
  (princ
    "\nВыберите текстовые объекты среди которых будет произведененна калькуляция"
    ) ;_ princ
  (setq
    value (rtos
        (apply
          (function +)
          (mapcar
        (function
          (lambda (a)
            (atof
              (vl-string-subst
            "."
            ","
            (cdr (assoc 1 (entget a)))
            ) ;_ vl-string-subst
              ) ;_ atof
            ) ;_ lambda
          ) ;_ function
        (vl-remove-if
          (function listp)
          (mapcar (function cadr)
              (ssnamex (ssget '((0 . "TEXT,MTEXT"))))
              ) ;_ mapcar
          ) ;_ vl-remove-if
        ) ;_ mapcar
          ) ;_ apply
        ) ;_ rtos
    ) ;_ setq
  (princ (strcat "\n Сумма = " value))
  (setvar "ERRNO" 0)
  (while
    (and (not (setq ent
             (car
               (nentsel
             (strcat
               "\n Выберите текстовый объект для записи значения <Выход>:"
               ) ;_ strcat
             ) ;_ entsel
               ) ;_ car
            ) ;_ setq
          ) ;_ not
     (equal (getvar "ERRNO") 7)
     ) ;_ and
     (setvar "ERRNO" 0)
     ) ;_ while
  (if (and ent
       (vlax-property-available-p
         (setq obj (vlax-ename->vla-object ent))
         'TextString
         ) ;_ vlax-property-available-p
       ) ;_ and
    (progn
      (vlax-put-property obj 'TextString value)
      (vlax-release-object obj)
      ) ;_ progn
    ) ;_ if
  (princ)
  ) ;_ defun

(defun c:z-calc-text-value (/ value ent obj ss)
  (vl-load-com)
  (princ
    "\nВыберите текстовые объекты среди которых будет произведененна калькуляция"
    ) ;_ princ
  (setq ss (ssget '((0 . "TEXT,MTEXT"))))
  (if (not ss)
    (princ "Не выбраны объекты")
    (progn
      (setq
    value (rtos
        (apply
          (function +)
          (mapcar
            (function
              (lambda (a)
            (atof
              (vl-string-trim
                "%Uu {\\Ll}"
                (vl-string-subst
                  "."
                  ","
                  (cdr (assoc 1 (entget a)))
                  ) ;_ vl-string-subst
                ) ;_ vl-string-trim
              ) ;_ atof
            ) ;_ lambda
              ) ;_ function
            (vl-remove-if
              (function listp)
              (mapcar (function cadr)
                  (ssnamex ss)
                  ) ;_ mapcar
              ) ;_ vl-remove-if
            ) ;_ mapcar
          ) ;_ apply
        ) ;_ rtos
    ) ;_ setq
      (if (vl-string-position (ascii ".") value)
    (setq value (vl-string-right-trim ".0" value))
    ) ;_ if
      (princ (strcat "\n Сумма = " value))
      (alert (strcat "Сумма = " value))
      (setvar "ERRNO" 0)
      (while
    (and (not (setq    ent
             (car
               (nentsel
                 (strcat
                   "\n Выберите текстовый объект для записи значения <Выход>:"
                   ) ;_ strcat
                 ) ;_ entsel
               ) ;_ car
            ) ;_ setq
          ) ;_ not
         (equal (getvar "ERRNO") 7)
         ) ;_ and
     (setvar "ERRNO" 0)
     ) ;_ while
      (if (and ent
           (vlax-property-available-p
         (setq obj (vlax-ename->vla-object ent))
         'TextString
         ) ;_ vlax-property-available-p
           ) ;_ and
    (progn
      (vlax-put-property obj 'TextString value)
      (vlax-release-object obj)
      ) ;_ progn
    ) ;_ if
      ) ;_ progn
    ) ;_ if
  (princ)
  ) ;_ defun

(setq value (vl-string-subst "," "." value))

(princ (strcat "\n Сумма = " value))