[Red Nova]

Я не пользуюсь таблицами AutoCADа, черчу ячейки, в них по мтексту. Вопрос как оперативно соcчитать сумму цифр их содержимого. Слышал есть такой калькулятор, по моему calcacad называется, но на 2008-й Cad не идет. Что делать?

Добавлено.
Постепенно форум перешел в разработку липа для расчета спецификаций из мтекстов, и расчет суммы из мтекстов стал просто полезной добавкой к расчету спецификации. Последний вариант программы находится тут

[skkkk]

Можешь подсказать ссылочку??

[Red Nova]

какую ссылочку?

[skkkk]

Ну где про атрибуты можно почитать... Хотя я книжку уже нашел, спасибо

[OHUKC]

привет, парниа можно ли сделать деление М-ТЕКСТОВ....аналогично суммированию и умножению????

[skkkk]

В лиспе из #422 поменяй в строчке

Код:

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

(function +)

плюс на нужный тебе знак, и имя команды измени, сделав несколько lsp-файлов, если хочешь, чтоб работало несколько арифм. функций

[OHUKC]

это я понял....а как сделать так , чтоб при произведение 2-ух чисел
результат выводился делённый на 1000????.....у меня просто в спецификации сечение развёртки в мм., общая длина в метрах, а площадь должна быть в метрах кв.....а в коде програмы не могу найти какой переменной, присваивается численное значение из строки...

[skkkk]

Тогда старайся точнее вопрос ставить
Это сделать можно точно, но без гуру лиспа не обойтись. Можешь, пока они не пришли, попробовать вариант отсюда http://dwg.ru/f/showthread.php?t=152...EC%E5%F2%EE%EA
# 41, только в строке

Код:

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

(setq newstr  (+ (atof str) value))

поставь нужный знак. Надо выбрать тексты, потом набрать число, на которое разделить (в оригинале - прибавить, ясное дело). Не супер вариант, но лучше, чем вручную считать. Можно рамкой выбирать тексты и быстрым выбором. Только там результат "зеленеет", но это удобно - не перепутаешь обработанные тексты. Там найдешь строку с комментарием о номере цвета и поставить можешь нужный

[OHUKC]

спасибо....но хотелось бы чтоб это при умножении делалось

[OHUKC]

не ...чето не получается ...ноль выдаёт

[CB]

В каком номере топика находится программа (что-то не хочется листать 25 страниц)

[OHUKC]

пост №16. страница 1.....

[skkkk]

А не лучше вариант из #422 на 22-й странице?
Добавлено.
Даже последняя редакция в #476, стр 24. Этот лисп может сразу форматировать обрабатываемый мтекст, также обрабатывает и тексты, атрибуты, ячейки таблицы и может менять цвет результата.

[OHUKC]

он навороченный и долго выбирать из всяких подменюшек....
мне этот больше понравился

[skkkk]

Там же нет никаких подменюшек... А чтобы не выскакивало окно "Сумма =", достаточно просто поставить перед словом "alert" в тексте кода точку с запятой.
А что у тебя не получилось, там где одни нули, я не понял?

Уважаемые гуру, не могли бы вы помимо задачи OHUKCA немного усложнить данный лисп, чтобы он выполнял следующее: пусть есть тексты с числами a, b и c. Нужно,чтобы лисп выполнял действие (а-b):c*1000. Хотелось бы так: вызываем лисп, кликаем а, b, c, затем правой кнопкой мыши (enter), затем кликаем текст-приемник. Ну и чтобы цвет менял как в #422 и 476. Заранее благодарен:-)

[CB]

По заявке OHUKC (синим - новое, красным - что закомментировали)

Код:

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

(defun c:z-calc-text-value (/ value ent obj ss action devide)
  (vl-load-com)
  (princ
    "\nВыберите текстовые объекты среди которых будет произведененна калькуляция"
    ) ;_ princ
  (setq ss (ssget "_:L" '((0 . "TEXT,MTEXT"))))
  (if (not ss)
    (princ "Не выбраны объекты")
    (progn
 
(initget "+ — * /")
(setq action (getkword "\nКакое действие произвести [+ — * /] :<+> "))
(if (not action)
 (setq action "+")
) ;_ end of if
(initget "Y N _ Н Т")
(setq devide (getkword "\nДелить результат на 1000? [Yes/No] :<No>"))
 
  (setq value
   (rtos
(/
    (apply
'((lambda () (eval (read action))))
      
;;;      (function '+)
 
      (mapcar
        (function
          (lambda (a)
      (atof
        (vl-string-trim
          "%Uu {\\Ll}"
          (vl-string-subst
            "."
            ","
            (mip_MTEXT_Unformat (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
 
(if devide 1000. 1.)
)
    
    ) ;_ 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
  (vlax-write-enabled-p obj)      
         ) ;_ and
  (progn
    (vlax-put-property obj 'TextString value)
    (vla-put-color obj 3)  ;_Цвет текста 3 - зеленый
    (vlax-release-object obj)
    ) ;_ progn
  ) ;_ if
      ) ;_ progn
    ) ;_ if
  (princ)
  ) ;_ defun
(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
  )

[OHUKC]

спасибо то что надо

[OHUKC]

а не подскажешь, где точность изменить ????...мне до 4-ого знака надо

[OHUKC]

и ещё не подскажешь , как сделать так чтоб результат при вставке не становился зелёным, а оставался такого же цвета , какого был М-Текст до вставки????

[OHUKC]

с цветом разобрался , а вот с точностью чё-то не догоняю где поменять????

[skkkk]

попробуй добавить после первой строки в коде строки

Код:

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

(command "luprec" 4); включает точность до четвертого знака
(command "dimzin" 0); отключает подавление нулей

При подавлении нулей (dimzin = 8) числа вида Х.ХХХ0 будут показаны как Х.ХХХ