;;;http://dwg.ru/f/showthread.php?t=16987&page=3
;|
  Назначение:  Суммирование Тектса,Мтекста, Размеров указанием или рамкой.
               Угловые размеры игнорируются
  Особенности: Безразлична к разделителям точка или запятая.
               Ввиду особенности работы atof стоки вида "22.3мама"
               будут учтены как число 22.3

               При выводе результата число округляется в соответствии
               с значением переменной num.
|;
;;;what - операция + или *
;;;newtext - t - новый текст, nil - указать текст
;;; num - количество знаков после запятой, nil - переменная LUPREC
(defun operate_text ( what newtext num / res selset ins_pt txt_height blk obj ed *error*)
  (defun *error* (msg)
    (setvar "NOMUTT" 0)  ;_ Восстанавливаем NOMUTT
    (princ msg)
    )
(vl-load-com)(if (eq what '*)(setq res 1.)(setq res 0.))
  (if (null num)(setq num (getvar "LUPREC")))
(princ "\nВыберите тексты или размеры: ")
  (setvar "NOMUTT" 1)  ;_ Отключаем NOMUTT
  (setq selset (ssget '((0 . "TEXT,MTEXT,*DIMENSION"))))
  (setvar "NOMUTT" 0)  ;_ Восстанавливаем NOMUTT
(if  selset
    (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex selset)))
     (setq obj (vlax-ename->vla-object ent)
           ed (entget ent)
           )
     (if (and (wcmatch (cdr(assoc 0 ed)) "*DIMENSION")
              (or
                (member '(100 . "AcDbAlignedDimension") ed)  ;_Параллельный или линейный
                (member '(100 . "AcDbDiametricDimension") ed);_Диаметр
                (member '(100 . "AcDbRadialDimension") ed)   ;_Радиус
                (member '(100 . "AcDbArcDimension") ed)      ;_Дуговой
                )
              )
       (progn
         (setq blk
             (vla-item (vla-get-blocks
                         (vla-get-activedocument (vlax-get-acad-object))
                       ) ;_ end of vla-get-Blocks
                       (cdr (assoc 2 ed))
             ) ;_ end of vla-item
      ) ;_ end of setq
      (vlax-for item blk
        (if (= (vla-get-objectname item) "AcDbMText")
          (setq obj item)
          )
         )
       )
       )
     (if (vlax-property-available-p obj 'Textstring)
       (progn
     (setq str (str-str-lst (vla-get-textstring obj) "\\P")
     str (mapcar '(lambda(x)(mip_mtext_unformat x)) str)
      str (mapcar '(lambda(x)(vl-string-translate "," "." (vl-string-trim  "%UuoOcC \t"   x))) str)
      str (mapcar '(lambda(x)(vl-string-trim  "%UuoOcC \t"   x)) str)
     res ((eval what) res (apply what (mapcar 'atof str))))
     )
       )
      ) ;_ end of foreach
    ) ;_ end of if
  (princ "\nРезультат=")(princ (rtos res 2 num))
 
  (if (not (equal res 0. 1e-3))
    (if newtext
    (progn
      (if (= (cdr (assoc 40 (tblsearch "STYLE" (getvar "TEXTSTYLE")))) 0.0) ;_ end of =
        (progn ;; нулевая высота текста
   (if (not (setq txt_height (getreal "\nВведите высоту текста <2.5> : ")))(setq txt_height 2.5))
          (vl-cmdf "_.TEXT" "0,0" txt_height 0 (rtos res 2 num))) ;_ end of progn
        (progn ;; фиксированнная высота
          (vl-cmdf "_.TEXT" "0,0" 0 txt (rtos res 2 num))) ;_ end of progn
         )
      (command "_.copybase" "0,0" (entlast) "" "_.erase" (entlast) "" "_.pasteclip" pause)
      ) ;_ end of progn
     (progn
       (TTC_Paste (rtos res 2 num) nil)
       )
    ) ;_ end of if
    )
   (princ)
  )

(defun TTC_Paste(pasteStr keepText / nslLst vlaObj)
(if (setq nslLst(nentsel "\nТекст вставки <выход> >>"))
(progn (cond
((and (= 4(length nslLst))
(= "DIMENSION"(cdr(assoc 0(entget(car(last nslLst))))))); end and
(setq vlaObj (vlax-ename->vla-object (cdr(assoc -1(entget(car(last nslLst)))))))
(setq oldStat (vla-get-Measurement vlaObj))
(if keepText
(if (= (vla-get-TextOverride vlaObj) "")
(setq pasteStr (strcat pasteStr (rtos oldStat (vla-get-UnitsFormat vlaObj) (vla-get-PrimaryUnitsPrecision vlaObj))))
(setq pasteStr (strcat pasteStr (vla-get-TextOverride vlaObj)))))
(if (vl-catch-all-error-p(vl-catch-all-apply 'vla-put-TextOverride(list vlaObj pasteStr)))
(princ "\n Can't paste. Object may be on locked layer. "))); end condition #1
((and (= 4(length nslLst))
(= "ACAD_TABLE"(cdr(assoc 0(entget(car(last nslLst))))))); end and
(setq vlaObj (vlax-ename->vla-object(car nslLst)))
(if keepText (setq pasteStr (strcat pasteStr (vla-get-TextString vlaobj))))
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-TextString(list vlaObj pasteStr)))
(princ "\nError. Can't pase text. ")(entupd (car(last nslLst))))); end condition # 2
((and (= 4(length nslLst))
(= "INSERT"(cdr(assoc 0(entget(car(last nslLst))))))); end and
(princ "\nCan't paste to block's DText or MText. ")); end condition #3
((and (= 2(length nslLst))
(member(cdr(assoc 0(entget(car nslLst)))) '("TEXT" "MTEXT" "ATTRIB" "ATTDEF"))); end and
(setq vlaObj (vlax-ename->vla-object(car nslLst)))
(if keepText (setq pasteStr (strcat pasteStr (vla-get-TextString vlaobj))))
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-TextString(list vlaObj pasteStr)))
(princ "\nError. Can't pase text. "))); end condition #4
(T (princ "\nCan't paste. Invalid object. ")); end condition #5
); end cond
T); end progn
nil); end if
);_TTC_PASTE
(defun mip_MTEXT_Unformat ( Mtext / text Str )
  (setq Text "")
   (while (/= Mtext "")
        (cond
          ((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[\\{}]")
            (setq Mtext (substr Mtext 3) Text   (strcat Text Str)))
          ((wcmatch (substr Mtext 1 1) "[{}]")(setq Mtext (substr Mtext 2)))
          ((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[LO`~]")
    (setq Mtext (substr Mtext 3)))
          ((wcmatch (strcase (substr Mtext 1 2)) "\\[ACFHQTW]")
            (setq Mtext (substr Mtext (+ 2 (vl-string-search ";" Mtext)))))
          ((wcmatch (strcase (substr Mtext 1 2)) "\\P")
            (if (or(= " " (substr Text (strlen Text)))
     (= " " (substr Mtext 3 1)))
               (setq Mtext (substr Mtext 3))
               (setq Mtext (substr Mtext 3) Text (strcat Text " "))))
   ((wcmatch (strcase (substr Mtext 1 2)) "\\S")
            (setq Str   (substr Mtext 3 (- (vl-string-search ";" Mtext) 2))
                  Text  (strcat Text (vl-string-translate "#^" "/^" Str))
                  Mtext (substr Mtext (+ 4 (strlen Str)))))
   (t (setq Text (strcat Text (substr Mtext 1 1)) Mtext (substr Mtext 2)))
   ))
  Text
  )
;|
* Ф-ция str-str-lst
* Сервисная ф-ция извлечения из строки данных, разделенных
* каким либо символом или строкой символов
* Возвращает список строк
* Аргументы [Type]:
  str - строка для разбора [STRING]
  pat - разделитель [STRING]
*  Пример запуска
  (setq str "мы;изучаем;рекурсии" pat ";")
  (setq str "мы — изучаем — рекурсии" pat " — ")
  (str-str-lst str pat)
* Читать подробнее http://www.autocad.ru/cgi-bin/f1/board.cgi?t=25113ot
|;
(defun str-str-lst (str pat / i)
  (cond ((= str "") nil)
        ((setq i (vl-string-search pat str))
         (cons (substr str 1 i)
               (str-str-lst (substr str (+ (strlen pat) 1 i)) pat)
         ) ;_  cons
        )
        (t (list str))
  ) ;_  cond
) ;_  defun
;;;SUMm Text -> New text
(defun c:sumTN ( / res selset ins_pt txt_height blk obj ed *error*)
  (operate_text '+ t 2)
   (princ)
  )
;;;SUMm Text Exist
(defun c:sumTE ( / res selset ins_pt txt_height blk obj ed *error*)
  (operate_text '+ nil 2)
   (princ)
  )
(defun c:mulTN ( / res selset ins_pt txt_height blk obj ed *error*)
  (operate_text '* t 2)
   (princ)
  )
;;;SUMm Text Exist
(defun c:mulTE ( / res selset ins_pt txt_height blk obj ed *error*)
  (operate_text '* nil 2)
   (princ)
  )
(princ "\nНаберите в командной строке \n
          SumTN - суммирование тестов в новый текст\n
          sumTE - суммирование тестов в существующий текст\n
          mulTN - умножение тестов в новый текст\n
          mulTE - умножение тестов в существующий текст\n")