[Fuzzywu]

Ребята подскажите, где нужно подправить данную программу, чтобы Мтекст содержащий числовые значения можно было суммировать правильно, здесь же происходит суммирование, но производится округление. Например есть два текста 0,125 и 0,5 . Их сумма 0,625, но программа округляет только до сотых - тоесть ответ равен 0,63, как исправить данный недочет. Заранее спасибо

Код:

[Выделить все]

 (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

[Кулик Алексей aka kpblc]

Округляет или показывает? Это принципиально разные вещи.
Для ради интересу выполни преобразование в строку, или lunits вместе с dimzin попробуй поменять.

[Fuzzywu]

Даже и не знаю, что ответить по поводу округления или показывания, так как я не сам писал программу, то ответить не смогу, не разбираюсь пока в Лиспе. В конце работы программа просит указать Мтекст, в который записывает полученное значение и оно да, округленное. ПОследнее твое предложение не понял вообще...

[Кулик Алексей aka kpblc]

А если так попробовать?

Код:

[Выделить все]

 (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
                2
                16
                ) ;_ 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

----- добавлено через 34 сек. -----
И, кстати, поиск показывает интересные результаты: http://www.google.ru/cse?cx=partner-...%82&gsc.page=1

[Fuzzywu]

Спасибо огромное, твой код работает на ура! А по поводу поиска отвечу, что данный код так и нашел здесь на форуме, он мне показался более интересным из всех, но столкнулся с ошибкой, описанной выше. Но теперь все работает, еще раз спасибо!