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

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

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

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

Red Nova · 23.02.2009, 17:36

VVA,
Ну раз писать код не охота, то помоги хотябы понять как кое что сделать.
Вот сижу и пытаюсь подчинить твой код, а он не дается.
Возьмем эту часть

Код:

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

(princ "\n============= Итог Работы==============\n")
      (foreach klass itog
        (princ "\nКласс : ")(princ (car klass))
      (mapcar '(lambda(line)
                 (terpri)
                 (princ (car line))
                 (foreach xx (cdr line)
                   (princ "\n     ")
                   (princ (car xx))
                   (princ "  -  ")
                   (princ (cadr xx))
                   (princ " кг.")
                   )
		 (princ counter)
                 (princ "\n-------------------------------------------------")
                 )
              (cdr klass)
              )
        )
      )
      (alert "Не совпадает кол-во текста в столбцах!")
  )
)
 (if (null ACET-GEOM-TEXTBOX )(alert "Необходима установка Express Tools!"))
  )
  
(vla-EndUndoMark (vla-get-activedocument (vlax-get-acad-object)))  
(princ)
)

Хочу добавить в "Итог Работы" в конце каждого ГОСТа строку с суммой масс всех профилей, типа

Код:

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

-------------------------------------------------
Класс : Прокат ВСТ3КП2
ГОСТ 10704-91
     Труба круглая 60х4  -  5.6 кг.
     Труба круглая 89х4  -  22.1 кг.
     Труба круглая 114х4  -  28.6 кг.
     Труба круглая 127х4  -  154.3 кг.
                     Итог  - 210.6 кг.
-------------------------------------------------

После пары часов прокрутки лиспа я пришел к выводу что нужно написать что-то типа

Код:

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

(setq counter 0)
(setq counter((cadr xx) + counter))
(princ counter)

и вставить эти строчки в нужные места, но репа не варит ... И в итоге ничего не вышло. Подскажи пожалуйста.

dextron3 · 23.02.2009, 18:25

не пойму зачем тебе это, трубы и уголки по отдельности взвешивать, ведь металл стоит одинакого, да и общая масса важней

Red Nova · 23.02.2009, 19:11

Ну до общей массы еще дойдем, а в ведомость расхода стали по закону нужно заполнить массу определенного Госта тоже.

Добавлено
Надо же, программа мне таки поддалась. Вот как надо было.

Код:

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

(foreach klass itog
        (princ "\nКласс : ")(princ (car klass))
      (mapcar '(lambda(line)
                 (terpri)
                 (princ (car line))
		 (setq counter 0)		 
                 (foreach xx (cdr line)
                   (princ "\n     ")
                   (princ (car xx))
                   (princ "  -  ")
                   (princ (cadr xx))
                   (princ " кг.")
		   (setq counter(+ (cadr xx) counter))
                   )
		 (princ "\n       ИТОГ  -  ")
		 (princ counter)
                 (princ " кг.")		 
                 (princ "\n-------------------------------------------------")
                 )
              (cdr klass)
              )
        )

Теперь надо подумать про общий итог

Еще добавлено
С общим итогом оказалось легче

Код:

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

      (princ "\n============= ИТОГ РАБОТЫ ==============\n")
      (setq counter2 0)
      (foreach klass itog
        (princ "\nКласс : ")(princ (car klass))
      (mapcar '(lambda(line)
                 (terpri)
                 (princ (car line))
		 (setq counter 0)		 
                 (foreach xx (cdr line)
                   (princ "\n     ")
                   (princ (car xx))
                   (princ "  -  ")
                   (princ (cadr xx))
                   (princ " кг.")
		   (setq counter(+ (cadr xx) counter))
                   )
		 (princ "\n     ИТОГ  -  ")
		 (princ counter)
                 (princ " кг.")		 
                 (princ "\n-------------------------------------------------")
		 (setq counter2 (+ counter2 counter))
                 )
              (cdr klass)
              )
        )
	(princ "\n     ОБЩИЙ ИТОГ  -  ")
      	(princ counter2)
        (princ " кг.")
        (princ "\n-------------------------------------------------")
      )

VVA · 24.02.2009, 10:37

Молодец. Можешь же когда захочешь. Вот мой вариант. Отличия только в названиях переменных.

Код:

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

      (princ "\n============= ИТОГ РАБОТЫ ==============\n")
      (setq allsum 0.0) ;;_Обнуляем массу всей стали
      (foreach klass itog
        (princ "\nКласс : ")(princ (car klass))
      (mapcar '(lambda(line / locsum)
                 (terpri)
   (setq locsum 0.0)  ;;_Обнуляем массу в пределах ГОСТа (локальную)
                 (princ (car line))
                 (foreach xx (cdr line)
                   (princ "\n     ")
                   (princ (car xx))
                   (princ "  -  ")
                   (princ (cadr xx))
     (setq locsum (+ locsum (cadr xx)))
                   (princ " кг.")
                   )
   (princ "\nИтого: ")(princ locsum)(princ " кг.")
                 (princ "\n-------------------------------------------------")
   (setq allsum (+ locsum allsum))
                 )
              (cdr klass)
              )
        )
       (princ "\n=================================================")
    (princ "\nВсего: ")(princ allsum)(princ " кг.")
    (princ "\n=================================================")

Ну и для тех кто не знаком с лиспом полный вариант (той версии, что еть у меня)
> Red Nova У меня к тебе еще одна просьба, как к зачинщику темы. Ориентироваться в 20 страницах уже тяжковато. Дай в 1-м посте ссылки на последние актуальные версии или размести их там.

Исправлена ошибка в SumTN с фиксированной высотой текстового стиля

В соответствии с #583 немного изменен алгоритм поиска новых типов. По умолчанию он ищется как для штучных материалов (болты, гайки, шайбы) Т.е. масса из базы умножается на количество. Соответсвенно добавлены перемычки по ГОСТ 948-84.

Файл sumTSW.rar - c добавлением 1% на сварку

Red Nova · 24.02.2009, 18:50

VVA,Сделал

А как на счет пункта 1 в #556? Этого я точно сам не сумею.

Piton · 26.02.2009, 11:43

Спасибо VVA за супер lisp

Добавил в базу арматуру А500с по СТО АСЧМ 7-93

Largo GT · 12.03.2009, 00:31

Я не знаю что делать, sumT.LSP во всех файлах работает кроме одного, самого нужного (по закону подлости

). Выбираю обьекты-enter, просит точку вставки-давлю, дальше ничего. Вот что пишет:

Цитата:

Команда: SumTN
(Округление до 2) Выберите тексты или размеры:
Результат= 36.73 с округлением= 36.73Ошибка приложения: В команду послан
неверный тип
_.copybase Базовая точка: 0,0
Выберите объекты: найдено: 1
Выберите объекты:
Команда: _.erase
Выберите объекты: найдено: 1
Выберите объекты:
Команда: _.pasteclip Повторное описание блока _ARCHTICK пропущено.
Повторное описание блока _Oblique пропущено.
Точка вставки:
Команда:

из-за чего это?
работаю в ACAD2007rus

VVA · 12.03.2009, 09:47

Largo GT,
1. Файлик покажи
2. _AUDIT в этом файле делал?
3. Вставь глючный файл в другой как блок с последующим расчленением.
4. ...

Largo GT · 12.03.2009, 16:22

Цитата:

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

Largo GT,
1. Файлик покажи
2. _AUDIT в этом файле делал?
3. Вставь глючный файл в другой как блок с последующим расчленением.
4. ...

1. Вложение 17199 план первого этажа, а таких у меня 20 штук в одном файле!
2. _AUDIT делал, 0 ошибок
3. Когда вставляю sumT.LSP работает, но все шрифты летят!!
История файла тяжела и печальна, из-за специфики работы, кочевал от одного проектировщика к другому, в версиях ACADa начиная с 12 по 2007 ! Так что строго не судите

Sleekka · 12.03.2009, 18:08

_wblock делал?

VVA · 12.03.2009, 18:37

Largo GT, Короче при обработке текстового стиля с фиксированной высотой текста была допущена описка. В свое время не отестировал как следует, т.к. никогда так не делаю.
Исправленную версию выложил в #567
Установи текущий текстовый стиль с 0 высотой текста и работай со старой версией или скачай новую.

Largo GT · 13.03.2009, 08:50

to Sleekka

Цитата:

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

_wblock делал?

делал

to VVA

Цитата:

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

Largo GT, Короче при обработке текстового стиля с фиксированной высотой текста была допущена описка. В свое время не отестировал как следует, т.к. никогда так не делаю.
Исправленную версию выложил в #567
Установи текущий текстовый стиль с 0 высотой текста и работай со старой версией или скачай новую.

текущий текстовой стиль не менял, скачал #567 все супер гуд , спасибо

Denis777 · 19.04.2009, 21:01

Очень интересная и полезная тема, спасибо всем кто принял учасие в разработке

! Но сложно разобраться какими командами в итоге вызывать программу и как это будет работать... объясните пж-та кому не сложно

Largo GT · 19.04.2009, 21:48

Цитата:

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

Очень интересная и полезная тема, спасибо всем кто принял учасие в разработке

! Но сложно разобраться какими командами в итоге вызывать программу и как это будет работать... объясните пж-та кому не сложно

В ACADe запусти appload, нажми F2 увидишь такое:

Код:

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

Опубликовано: http:////dwg.ru//f//showthread.php?t=16987 сборка(пост) #449
Наберите в командной строке
SumTN - суммирование тестов в новый текст
SumTE - суммирование тестов в существующий текст
MulTN - умножение тестов в новый текст
MulTE - умножение тестов в существующий текст
TOKR  - округление текста
MulTC - перемножение текстов столбцами
MulTCv2 - перемножение текстов столбцами вариант 2
sumTSet - установки округления и высоты новых текстов
GSUM - рассчет групповой спецификации
SPECKG - рассчет спецификации (SPEC3 SPEC3D SPEC4 SPEC4D SPEC5 SPEC5D
SPECW - рассчет спецификации деревянных изделий (SPEC Wood
_-HYPERLINK - удаление гиперссылок (опция _Remove)

пишешь команды и следуешь подсказкам

Denis777 · 19.04.2009, 21:56

Largo GT
Спасибо! на неделе опробую в полную силу на работе...

danilochek13 · 26.05.2009, 12:20

Товарищи помогите!!!! можно ли переписать программу для подсчета суммы размеров, что бы вместо результата расчета выдавалась формула в текстовом виде: 3600+700+1000 и т.д. ??????????????????????????

Кулик Алексей aka kpblc · 26.05.2009, 21:47

danilochek13, ты еще больше вопросительных знаков поставь. Ответ: при определенном желании и возможностях - наверное, можно. Даже не наверное. Можно. Точка.
Но у меня нет ни времени, ни возможности. Особенно учитывая возможности полей вкупе с _.ddedit

danilochek13 · 27.05.2009, 09:58

Кулик Алексей, спасибо за ответ..просто я ведомость отделки помещений считаю в Excel и что бы не вбивать размеры простенков вручную хотелось что бы при выделении нескольких размеров автокад выдавал формулу в текстовом виде: 1490+1120+1865+1905+1610+8200, а я бы копировал ее в Exel.

VVA · 27.05.2009, 10:55

danilochek13,

Код:

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

(defun C:TEST (/ ss i lst)
  ;;for danilochek13
  ;; http://forum.dwg.ru/showthread.php?p=401934#post401934
  (vl-load-com)
  (if (= (getvar "DWGCODEPAGE") "ANSI_1251")
    (princ "\nВыберите размеры : ")
    (princ "\nSelect dimension : ")
  ) ;_ end of if
  (if (setq ss (ssget "_:L" '((0 . "*DIMENSION"))))
    (progn
      (setq i	'-1
	    lst	nil
      ) ;_ end of setq
      (repeat (sslength ss)
	(setq lst (cons (ssname ss (setq i (1+ i))) lst))
      ) ;_ end of repeat
      (setq ss nil
	    ss (mapcar 'dim-get-text-string lst)
      ) ;_ end of setq
      (princ
	(strcat	"\n"
		(car ss)
		(apply 'strcat
		       (mapcar '(lambda (x) (strcat "+" x)) (cdr ss))
		) ;_ end of apply
	) ;_ end of strcat
      ) ;_ end of princ
    ) ;_ end of progn
  ) ;_ end of if
  (princ)
) ;_ end of defun

(defun dim-get-text-string (dim / str)
  (setq str "")
  (vlax-for item
	    (vla-item (vla-get-blocks
			(vla-get-activedocument (vlax-get-acad-object))
		      ) ;_ end of vla-get-Blocks
		      (cdr (assoc 2 (entget dim)))
	    ) ;_ end of vla-item
    (if	(vlax-property-available-p item 'Textstring)
      (setq str (vla-get-textstring item))
    ) ;_ end of if
  ) ;_ end of vlax-for
  (mip_MTEXT_Unformat str)
) ;_ end of defun
(defun mip_MTEXT_Unformat (Mtext / text Str)
  (setq MM Mtext)
  (setq Text "")
  (while (/= Mtext "")
    (cond
      ((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[\\{}]")
       (setq Mtext (substr Mtext 3)
	     Text  (strcat Text Str)
       ) ;_ end of setq
      )
      ((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 4)) "\\PQ[CRJD],\\PXQ") ;_ Add by KPblC
       (setq mtext (substr mtext (+ 2 (vl-string-search ";" mtext))))
      )
      ((wcmatch (strcase (substr Mtext 1 2)) "\\P")
       (if (or
	     (zerop (strlen Text))
	     (= " " (substr Text (strlen Text)))
	     (= " " (substr Mtext 3 1))
	   ) ;_ end of or
	 (setq Mtext (substr Mtext 3))
	 (setq Mtext (substr Mtext 3)
	       Text  (strcat Text " ")
	 ) ;_ end of setq
       ) ;_ end of if
      )
      ((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)))
       ) ;_ end of setq
      )
      (t
       (setq Text  (strcat Text (substr Mtext 1 1))
	     Mtext (substr Mtext 2)
       ) ;_ end of setq
      )
    ) ;_ end of cond
  ) ;_ end of while
  Text
) ;_ end of defun
(princ "\nType TEST in command line")

danilochek13 · 27.05.2009, 17:37

VVA выочень мне помогли спасибо!
Протестировал код из поста #579 в 2008 руссифицированном Автокаде и в 2007 английском работает нормально, а в 2007 англицком с СПДС выдает ошибку:
; error: no function definition: nil........видимо это из за СПДС

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Сейсмозащита и сейсмоизоляция существующих, построенных зд.	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.
Просмотров: 197013