Как сосчитать сумму цифр из отдельных мтекстов (и лисп для подсчета спецификаций)

Расчет спецификаций из мтекстов · 26.01.2008, 13:15

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

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

Кулик Алексей aka kpblc · 21.03.2023, 21:16

Если по-быстрому, то в коде попробуй поменять "L=" на "\\P" (на англ.раскладке).

MrBrown · 21.03.2023, 21:39

Кулик Алексей aka kpblc, Пробовал.
Может быть, капсом надо было букву "Р" вставить.
Пробую ещё.
_________________________
Заработало! И, похоже, дело не в капсе, а в моей невнимательности при корректировке кода.
Спасибо!

VVA · 23.03.2023, 09:42

Цитата:

Сообщение от MrBrown

См. пост #650 от VVA. Там есть макрос, фильтрующий числа в Мтексте и суммирующий их.
Я понял, что он суммирует числа, стоящие после "L=".
Большая просьба к специалистам: подкорректируйте, пожалуйста, макрос, чтобы он суммировал только длины труб в Мтекстах, содержащих, кроме длины, диаметр и перенос на вторую строку (см. картинку).
Я пытался вместо "L=" вставить знак переноса в разных вариантах, не работает.

Там простой заменой не получится. Первый блок с L= удаляет тексты, у которых нет строки L=. Его надо выбросить

Код:

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

;_*** Сумма числовых значений. ТЗ см пост #660 ( https://forum.dwg.ru/showpost.php?p=2028075&postcount=660 )
;_ https://forum.dwg.ru/showthread.php?t=16987&page=34

(defun c:sumP (/ fld)
  ;_sum pipe length
  (vl-load-com)
  (princ
    "\nВыберите текстовые объекты среди которых будет произведена калькуляция"
  ) ;_ end of princ
  (princ
    (strcat
      "\nСумма = "
      (setq fld
      (rtos
        (apply
          (function +)
          (mapcar
            '(lambda (z)
               (atof (vl-string-subst
                       "."
                       ","
                       (vl-princ-to-string (cadr (str-str-lst z "\\P")))
                     ) ;_ end of vl-string-subst
               ) ;_ end of atof
             ) ;_ end of lambda
            (mapcar
                (function
                  (lambda (a)
                    (cdr (assoc 1 (entget a)))
                  ) ;_ end of lambda
                ) ;_ end of function
                (vl-remove-if
                  (function listp)
                  (mapcar (function cadr)
                          (ssnamex (ssget '((0 . "TEXT,MTEXT"))))
                  ) ;_ end of mapcar
                ) ;_ end of vl-remove-if
              )
          ) ;_ end of mapcar
        ) ;_ end of apply
        2
        1
      ) ;_end of rtos
            )
    ) ;_ end of strcat
  ) ;_ end of princ
  (princ)
)
(defun c:sumPT (/ fld tstyle txt pt tblobj tblset row col)
  ;_sum pipe to text
  (vl-load-com)
  (or *TEXTSIZE* (setq *TEXTSIZE* (getvar "TEXTSIZE")))
  (princ
    "\nВыберите текстовые объекты среди которых будет произведененна калькуляция"
  ) ;_ end of princ
  (princ
    (strcat
      "\nСумма = "
      (setq fld
      (rtos
        (apply
          (function +)
          (mapcar
            '(lambda (z)
               (atof (vl-string-subst
                       "."
                       ","
                       (vl-princ-to-string (cadr (str-str-lst z "\\P")))
                     ) ;_ end of vl-string-subst
               ) ;_ end of atof
             ) ;_ end of lambda
            (mapcar
                (function
                  (lambda (a)
                    (cdr (assoc 1 (entget a)))
                  ) ;_ end of lambda
                ) ;_ end of function
                (vl-remove-if
                  (function listp)
                  (mapcar (function cadr)
                          (ssnamex (ssget '((0 . "TEXT,MTEXT"))))
                  ) ;_ end of mapcar
                ) ;_ end of vl-remove-if
              )
          ) ;_ end of mapcar
        ) ;_ end of apply
        2
        1
      ) ;_end of rtos
            )
    ) ;_ end of strcat
  ) ;_ end of princ

(setvar "cmdecho" 0)
(setq tstyle (getvar "TEXTSTYLE")) ;_Стиль текста Стиль должен существовать
    ;_ Создаем текст
(if (= (cdr (assoc 40 (tblsearch "STYLE" tstyle))) 0.0)
     ;; нулевая высота текста
   (vl-cmdf "_.-TEXT" "_S" tstyle "_none" '(0 0 0) *TEXTSIZE* 0 fld)
   (vl-cmdf "_.-TEXT" "_S" tstyle "_none" '(0 0 0) 0 fld)
   ) ;_ end of if
    (setq txt (entlast))
  ;_ Копируем в буфер и обратно
  (vl-cmdf "_updatefield" txt "")
  (princ "\n Укажите точку вставки текста или ячейку таблицы:")
  (vl-cmdf "_.copybase" (trans '(0 0 0) 0 1) txt "" "_.erase" txt "" "_.pasteclip" "_none" pause)
  ;_ В txt примитив текста в pt точка вставки  
  (setq txt (entlast) pt (getvar "LASTPOINT"))
  (or
    (and ;_Проверяем, попала ли точка в ячейку таблицы
      (setq  tblobj nil tblset (ssget "_X" (list '(0 . "ACAD_TABLE")(cons 410 (getvar "CTAB")))))
      (setq lst (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex tblset)))))
      (progn
        (vl-catch-all-apply '(lambda()
        (mapcar '(lambda (x)
           (or tblobj
               (and
                 (= :vlax-true (vla-HitTest x
                               (vlax-3d-point (trans pt 1 0))
                               (vlax-3d-point (trans (getvar "VIEWDIR") 1 0))
                               'row 'col))
                 (setq tblobj x)
                 )
               )
           )
        lst)
                               )
          )
        tblobj
        )
       row col
      (or (vla-SetText tblobj row col fld) t)
      (entdel txt)
      )
    (and ;_Не попала, рисуем текст с полем
      (setq txt (vlax-ename->vla-object txt))
      (vlax-write-enabled-p txt)
      (vlax-method-applicable-p txt 'FieldCode) ;_есть метод FieldCode
      (vlax-property-available-p txt 'TextString)
      (vlax-put txt 'TextString fld)
      )
    )
  (princ)
) ;_ end of defun

 ;|
* Ф-ция 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
(princ "\nType in command line SUMP and SUMPT")(princ)

MrBrown · 29.03.2023, 23:32

Здравствуйте!
Используя код из поста #663 от VVA (моя благодарность), Сделал несколько макросов для определения длины трубопроводов определённого диаметра, вместо "\\P" вставив "%%C25\\P" или, например, "%%C32\\P".
Получилось изрядно - целых восемь макросов. Озаглавил "S20", "S25", "S32" и т.д. Вызываю нужный макрос и получаю соответствующую общую длину конкретного диаметра.
Прошу: скорректируйте, пожалуйста, макрос, чтобы он был только один, но запрашивал диаметр перед выбором Мтекстов. Чтобы после приглашения "Выберите диаметр трубопровода" можно было просто набрать "25" или "32". И дальше - по накатанной - выбор рамкой нужной области чертежа.
Спасибо.

VVA · 31.03.2023, 16:22

Цитата:

Сообщение от MrBrown

Чтобы после приглашения "Выберите диаметр трубопровода" можно было просто набрать "25" или "32

Тогда уже лучше "Укажите диаметр трубопровода"
Не тестировал, но думаю ничего не испортил, должно работать. Если на запрос диаметра ввести пустой ввод, должно считать все диметры

Код:

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

;_*** Сумма числовых значений. ТЗ см пост #664 ( https://forum.dwg.ru/showpost.php?p=2028075&postcount=664 )
;_ https://forum.dwg.ru/showthread.php?t=16987&page=34

(defun c:sumP (/ fld dia)
  ;_sum pipe length
  (vl-load-com)
  (initget 4)
  (setq dia (getint "\nУкажите диаметр трубопровода <любой>: "))
  (princ
    "\nВыберите текстовые объекты среди которых будет произведена калькуляция"
  ) ;_ end of princ
  (princ
    (strcat
      "\nСумма = "
      (setq fld
      (rtos
        (apply
          (function +)
          (mapcar
            '(lambda (z)
               (atof (vl-string-subst
                       "."
                       ","
                       (vl-princ-to-string (cadr (str-str-lst z (if dia (strcat "%%C" (itoa dia) "\\P") "\\P"))))
                     ) ;_ end of vl-string-subst
               ) ;_ end of atof
             ) ;_ end of lambda
            (mapcar
                (function
                  (lambda (a)
                    (cdr (assoc 1 (entget a)))
                  ) ;_ end of lambda
                ) ;_ end of function
                (vl-remove-if
                  (function listp)
                  (mapcar (function cadr)
                          (ssnamex (ssget '((0 . "TEXT,MTEXT"))))
                  ) ;_ end of mapcar
                ) ;_ end of vl-remove-if
              )
          ) ;_ end of mapcar
        ) ;_ end of apply
        2
        1
      ) ;_end of rtos
            )
    ) ;_ end of strcat
  ) ;_ end of princ
  (princ)
)
(defun c:sumPT (/ fld tstyle txt pt tblobj tblset row col dia)
  ;_sum pipe to text
  (vl-load-com)
  (or *TEXTSIZE* (setq *TEXTSIZE* (getvar "TEXTSIZE")))
    (initget 4)
  (setq dia (getint "\nУкажите диаметр трубопровода <любой>: "))
  (princ
    "\nВыберите текстовые объекты среди которых будет произведененна калькуляция"
  ) ;_ end of princ
  (princ
    (strcat
      "\nСумма = "
      (setq fld
      (rtos
        (apply
          (function +)
          (mapcar
            '(lambda (z)
               (atof (vl-string-subst
                       "."
                       ","
                       (vl-princ-to-string (cadr (str-str-lst z (if dia (strcat "%%C" (itoa dia) "\\P") "\\P"))))
                     ) ;_ end of vl-string-subst
               ) ;_ end of atof
             ) ;_ end of lambda
            (mapcar
                (function
                  (lambda (a)
                    (cdr (assoc 1 (entget a)))
                  ) ;_ end of lambda
                ) ;_ end of function
                (vl-remove-if
                  (function listp)
                  (mapcar (function cadr)
                          (ssnamex (ssget '((0 . "TEXT,MTEXT"))))
                  ) ;_ end of mapcar
                ) ;_ end of vl-remove-if
              )
          ) ;_ end of mapcar
        ) ;_ end of apply
        2
        1
      ) ;_end of rtos
            )
    ) ;_ end of strcat
  ) ;_ end of princ

(setvar "cmdecho" 0)
(setq tstyle (getvar "TEXTSTYLE")) ;_Стиль текста Стиль должен существовать
    ;_ Создаем текст
(if (= (cdr (assoc 40 (tblsearch "STYLE" tstyle))) 0.0)
     ;; нулевая высота текста
   (vl-cmdf "_.-TEXT" "_S" tstyle "_none" '(0 0 0) *TEXTSIZE* 0 fld)
   (vl-cmdf "_.-TEXT" "_S" tstyle "_none" '(0 0 0) 0 fld)
   ) ;_ end of if
    (setq txt (entlast))
  ;_ Копируем в буфер и обратно
  (vl-cmdf "_updatefield" txt "")
  (princ "\n Укажите точку вставки текста или ячейку таблицы:")
  (vl-cmdf "_.copybase" (trans '(0 0 0) 0 1) txt "" "_.erase" txt "" "_.pasteclip" "_none" pause)
  ;_ В txt примитив текста в pt точка вставки  
  (setq txt (entlast) pt (getvar "LASTPOINT"))
  (or
    (and ;_Проверяем, попала ли точка в ячейку таблицы
      (setq  tblobj nil tblset (ssget "_X" (list '(0 . "ACAD_TABLE")(cons 410 (getvar "CTAB")))))
      (setq lst (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex tblset)))))
      (progn
        (vl-catch-all-apply '(lambda()
        (mapcar '(lambda (x)
           (or tblobj
               (and
                 (= :vlax-true (vla-HitTest x
                               (vlax-3d-point (trans pt 1 0))
                               (vlax-3d-point (trans (getvar "VIEWDIR") 1 0))
                               'row 'col))
                 (setq tblobj x)
                 )
               )
           )
        lst)
                               )
          )
        tblobj
        )
       row col
      (or (vla-SetText tblobj row col fld) t)
      (entdel txt)
      )
    (and ;_Не попала, рисуем текст с полем
      (setq txt (vlax-ename->vla-object txt))
      (vlax-write-enabled-p txt)
      (vlax-method-applicable-p txt 'FieldCode) ;_есть метод FieldCode
      (vlax-property-available-p txt 'TextString)
      (vlax-put txt 'TextString fld)
      )
    )
  (princ)
) ;_ end of defun

 ;|
* Ф-ция 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
(princ "\nType in command line SUMP and SUMPT")(princ)

MrBrown · 31.03.2023, 18:40

VVA, Прекрасно работает! Моя благодарность.

MrBrown · 07.06.2023, 14:00

VVA, а можно ли сделать так, чтобы, если не вводить конкретный диаметр, макрос не просто считал бы все трубы, а сортировал по диаметрам и сводил бы это в простенькую таблицу?
Если не сложно, большая просьба усовершенствовать макрос.
Спасибо.

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Сейсмозащита и сейсмоизоляция существующих, построенных зд.	IANationalInformAgentstvo	Прочее. Архитектура и строительство	216	20.01.2015 16:51
Предложения по расчетным моделям сооружений	aldt	Расчетные программы	8	06.07.2009 17:53
Мониторы LCD CRT		Разное	94	17.06.2008 10:51
ЮМОР 2006 =)	Perezz!!	Разное	1122	04.01.2007 00:46

26.01.2008, 13:15
Расчет спецификаций из мтекстов Red Nova ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ. Торонто Регистрация: 23.10.2007 Сообщений: 1,980 Я не пользуюсь таблицами AutoCADа, черчу ячейки, в них по мтексту. Вопрос как оперативно соcчитать сумму цифр их содержимого. Слышал есть такой калькулятор, по моему calcacad называется, но на 2008-й Cad не идет. Что делать? Добавлено. Постепенно форум перешел в разработку липа для расчета спецификаций из мтекстов, и расчет суммы из мтекстов стал просто полезной добавкой к расчету спецификации. Последний вариант программы находится тут Последний раз редактировалось Red Nova, 13.03.2009 в 10:11.
Просмотров: 197300