| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Как сосчитать сумму цифр из отдельных мтекстов (и лисп для подсчета спецификаций)

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

Ответ
Поиск в этой теме
Непрочитано 26.01.2008, 13:15
Расчет спецификаций из мтекстов
Red Nova
 
ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Торонто
Регистрация: 23.10.2007
Сообщений: 1,980

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

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

Последний раз редактировалось Red Nova, 13.03.2009 в 10:11.
Просмотров: 196226
 
Непрочитано 13.02.2008, 14:09
#41
Олег К.

Инженер-теплотехник
 
Регистрация: 17.08.2006
Смоленск
Сообщений: 307


Надо же, все оказалось проще, чем думал. Мог бы и вчера доделать.
Выкладываю последний вариант. Добавлена работа с размерами и вставка результата в размерный текст, вот только радиусы и диаметры не берет, и дуговые в радианах считает. Да так ли уж часто нужно такие размеры вычислять. Установка числа знаков после запятой снесена в пункт "Опции", по умолчанию =1 (самого этот запрос уже достал). Нельзя ввести ноль - так я от деления на ноль избавился. Обнаружилась интересная особенность: нельзя два раза подряд сделать вывод результата - логика программы не позволяет.

Еще просьба, кому не лень потестируйте программку в AutoCAD 2008, ZW/Proge/Brics CADах.
Вложения
Тип файла: lsp TextCalc-v4.3.LSP (11.5 Кб, 739 просмотров)
Олег К. вне форума  
 
Непрочитано 13.02.2008, 16:07
#42
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Чуток подправил твой код. Теперь игнорирует угловые размеры, обрабатывает дуговой размер. Надеюсь ничего не испортил
Код:
[Выделить все]
;;;  TEXTCALC - TEXT CALCULATION  ver 4.3
;;;
;;; All rights reserved including right of reproduction in whole or in part in ang form.
;;; Данная программа производит вычисления значений взятых из текста. Запрашивает указание тестового
;;; примитива с числом или ввод числа с клавиатуры, выбор арифметического действия (+, -, * или /).
;;; Вывод результата:  в существующий текст (изменение содержания) или создание нового текста
;;; с результатом (ОБЯЗАТЕЛЬНО УКАЗАТЬ ОБРАЗЕЦ ТЕКСТОВОГО ПРИМИТИВА !!!).
;;; После каждого (кроме первого) задания чисел в командную строку выводится текущий результат
;;; По вопросам о работе программы просьба обращаться в отдел ТТОВ к Крылову О.В.
;;;
;;; 12.02.2008: добавлена возможность брать значения размеров и выводить результат в размерный текст.
;;;             не работает с радиусами и диаметрами, дуговые размеры берутся в радианах.
(defun C:TextCalc (/ *error* numerror ExitNumFun oneobj numtext numfuntext numresult resultvar 
                 changeobj textlayer textprecision bit1 bit7 bit8 bit10 bit40 bit67 bit410 
                 resultexit numout)
;;; ФУНКЦИЯ ВЫЧИСЛЕНИЯ ЗНАЧЕНИЙ ВЗЯТЫХ ИЗ ТЕКСТОВЫХ ПРИМИТИВОВ
  (gc)
  (setq p_cmdecho (getvar "CMDECHO") p_osmode (getvar "OSMODE") p_blipmode (getvar "BLIPMODE"))
; Переопределение функции *error*, вместо стандартной
 (defun *error* (msg)
   (princ "Программа прервана пользователем")
   (setvar "CMDECHO" p_cmdecho)
   (setvar "OSMODE" p_osmode)
   (setvar "BLIPMODE" p_blipmode)
   (setq p_cmdecho nil p_osmode nil p_blipmode nil)
   (setq numerror nil ExitNumFun nil oneobj nil numtext nil numfuntext nil numfunction nil numresult nil numout nil textprecision nil)
   ; (princ "\n ERREND")
   (princ)
 ) ; defun(*error*)
 (setvar "CMDECHO" 0)
 (setvar "OSMODE" 0)
 (setvar "BLIPMODE" 0)
 (setq oneobj nil numtext nil numfuntext nil numfunction nil number1 nil numresult nil number2 nil ExitNumFun nil textprecision 1) 
  
 (princ "\n\t ВЫЧИСЛЕНИЕ ТЕКСТА")
 (while (null ExitNumFun)
   (setvar "ERRNO" 0)
   (initget "Число Функция Результат Опции Выход X A H J D _X A H J D X A H J D")
   (setq oneobj (entsel "\n Укажите текст или [Число/Функция/Результат/Опции/Выход] <Выход>: "))
;----- Действия программы при пустом вводе
   (if (null oneobj)
     (progn
       (setq numerror (getvar "ERRNO"))
       (cond
  ((= numerror 7) (princ "\n Вы промахнулись, ничего не выбрано. Выберите еще раз. \n"))
  ((= numerror 52) (setq oneobj "D"))
       ) ; cond
       (setq numerror nil)
       (setvar "ERRNO" 0)
     ) ; progn
   ) ; if(null oneobj)
;----- Действия программы при выборе текстового примитива
   (if (= (type oneobj) 'list)
     (progn ; _1
       (if (= (type (setq oneobj (car oneobj))) 'ename)
         (progn ; _2
    (cond
      ((and            ;_ Modifyed VVA >
                (wcmatch (cdr (assoc 0 (entget oneobj))) "*DIMENSION") ;_ DIMENSION and ARC_DIMENSION
                (or
                (member '(100 . "AcDbAlignedDimension") (entget oneobj))  ;_Параллельный или линейный
                (member '(100 . "AcDbDiametricDimension") (entget oneobj));_Диаметр
                (member '(100 . "AcDbRadialDimension") (entget oneobj))   ;_Радиус
                (member '(100 . "AcDbArcDimension") (entget oneobj))      ;_Дуговой
                )
                )             ;_ Modifyed VVA <
       (if (eq (cdr (assoc 1 (entget oneobj))) "")
  (setq numtext (cdr (assoc 42 (entget oneobj))))
  (setq numtext (atof (cdr (assoc 1 (entget oneobj)))))
       ) ; if
      ) ; oneobj - размер
      ((vlax-property-available-p (vlax-ename->vla-object oneobj) 'textstring)
       (setq numtext (_Cris-UnfTextStr (vla-get-TextString (vlax-ename->vla-object oneobj))))
      ) ; oneobj - текст
      (T (princ "\n Этот объект не текст. Выберите еще раз") (princ)
      ) ; oneobj - любой другой объект AutoCAD'а
    ) ; cond
    (setq oneobj nil)
         ) ; progn_2
       ) ;  if(type)=ename
     ) ; progn_1
   ) ;  if(type)=list
    
;----- Действия программы при выборе опции ввода числа с клавиатуры
   (if (member oneobj '("Число" "X")) ; oneobj=Число
     (setq numtext (getreal "\n Введите число <Отмена>: ") oneobj nil)
   ) ; if(число)
; Проверка numtext на ноль (возникает если выбран MText или Text у которого
; первый символ не цифра, так же могут специально ввести 0) и запрет вычисления
   (if (eq numtext 0)
     (progn
       (princ "\n\t В выбранном тексте в начале не цифра, либо ВЫ специально ввели ноль.
               \n\t НЕ ПОЙДЁ-ОТ !!! Повторите ввод правильно!") (princ)
       (setq numtext nil)
     ) ; progn
   ) ; if(ноль)
;----- Действия программы при выборе опции ввода математической функции.
; Автоматический запрос выбора функции при наличии первого аргумента,
; выбранного в виде текстового примитива или введенного с клавиатуры
    (if (or (member oneobj '("Функция" "A")) ; oneobj=Функция
     (and (null numfuntext)
   (not (null numtext))
     ) ; and
 ) ; or
      (progn
 (initget 6 "+ - * /")
 (setq numfuntext (getkword "\n\n Выберите действие [ + / - / * //] <Отмена>: "))
 (setq numfunction (cond
         ((= numfuntext "+") +)
       ((= numfuntext "-") -)
       ((= numfuntext "*") *)
       ((= numfuntext "/") /)
     ) ; cond
 ) ; setq
 (setq oneobj nil)
      ) ; progn
    ) ; if(функция)
   
;----- Действия программы при выборе пункта "Опции"
   (if (member oneobj '("Опции" "J")) ; oneobj=Опции
     (progn
       (initget 4 "0 1 2 3 4 5 6 7 8 9")
       (setq textprecision (getint "\n Сколько оставить цифр после запятой [0 - 9] <1>: "))
       (if (null textprecision) (setq textprecision 1))
     ) ; progn
   ) ; if(опции)
   
;----- Действия программы при выборе опции вывода результата.
; Варианты вывода: изменить существующий текстовой примитив или создать новый
; по выбранному образцу. Действия при ошибочном выборе опции.
    (if (and (member oneobj '("Результат" "H")) (not (null numresult))) ; oneobj=Результат
      (progn ; _1
 (initget 15 "Изменить Создать B C _B C B C")
 (setq resultvar (getkword "\n Изменить существующий или создать новый текст? [Изменить/Создать]: "))
 (cond
   ((member resultvar '("Изменить" "B")) ; resultvar=Изменить
    (princ "\n Выберите объект для изменения: ")
    (setq changeobj (entget (ssname (ssget "_:S" '((0 . "*TEXT,DIMENSION"))) 0)) textlayer (cdr (assoc 8 changeobj)))
    (if (= (cdr (assoc 70 (tblsearch "LAYER" textlayer))) 4)  ; бит70 = 4 - слой заблокирован (проверять для каждой версии AutoCAD'a)
             (vl-cmdf "_.-layer" "_U" textlayer "")
    )
    (entmod (subst (cons 1 (rtos numresult 2 textprecision)) (assoc 1 changeobj) changeobj))
    (setq changeobj nil textlayer nil resultvar nil)
   ) ; resultvar=Изменить
   ((member resultvar '("Создать" "C")) ; resultvar=Создать
    (princ "\n Выберите образец для нового текста (укажите существующий текст): ")
    (setq changeobj (entget (ssname (ssget "_:S" '((0 . "*TEXT"))) 0)) textlayer (cdr (assoc 8 changeobj)))
    (if (= (cdr (assoc 70 (tblsearch "LAYER" textlayer))) 4)  ; бит 4 - слой заблокирован (проверять для каждой версии AutoCAD'a)
             (vl-cmdf "_.-layer" "_U" textlayer "")
    )
           (setq bit7 (assoc 7 changeobj)
                 bit8 (assoc 8 changeobj)
                 bit40 (assoc 40 changeobj)
                 bit67 (assoc 67 changeobj)
                 bit410 (assoc 410 changeobj))
           (initget 15)
           (setq bit10 (append '(10) (getpoint "\n Укажите точку вставки текста: ")))
    (setq bit1 (cons 1 (rtos numresult 2 textprecision)))
    (entmakex (list '(0 . "MTEXT") '(100 . "AcDbEntity") bit67 bit410 bit8 '(100 . "AcDbMText") bit10 bit40 '(41 . 0.0) '(71 . 5) bit1 bit7 '(210 0.0 0.0 1.0) '(50 . 0.0)))
    (setq bit1 nil bit7 nil bit8 nil bit10 nil bit40 nil bit67 nil bit410 nil
   changeobj nil textlayer nil resultvar nil)
   ) ; resultvar=Создать
 ) ; cond(resultvar)
 
   ; вывод запроса на продолжение расчетов
        (initget 15 "Продолжить Новый Выход G Y D _G Y D G Y D")
 (setq resultexit (getkword "\n Продолжить вычисления, начать новые или выход? [Продолжить/Новый/Выход]: "))
        (cond
   ((member resultexit '("Продолжить" "G")) (setq number1 numresult)) ; resultexit=Продолжить
   ((member resultexit '("Новый" "Y")) (setq numfunction nil numfuntext nil number1 nil)) ; resultexit=Новый
   ((member resultexit '("Выход" "D")) (setq numfunction nil numfuntext nil number1 nil ExitNumFun T textprecision nil)) ; resultexit=Выход
 ) ; cond(resultexit)
        (setq oneobj nil resultexit nil number2 nil numresult nil)
      ) ; progn_1
    ) ; if(numresult)=T
   
;----- Действия программы, когда выбрана опция вывода результата, но результат не вычислен
    (if (and (member oneobj '("Результат" "H")) (null numresult)) ; oneobj=Результат
      (progn
 (princ "\n Результат не может быть выведен, так как нет данных для вычислений")
 (princ) (setq oneobj nil)
      ) ; progn
    ) ; if(numresult)=nil
  
;----- Действия программы при выборе опции выхода.
; Если есть результат вычислений требуется дополнительное подтверждение.
    (cond
      ((and (member oneobj '("Выход" "D")) (not (null numresult))) ; oneobj=Выход
       (initget 6 "Да Нет L Y _L Y L Y")
 (setq numout (getkword "\n Вы хотите выйти без сохранения результата вычислений? [Да / Нет] <Нет> :"))
 (if (member numout '("Да" "L")) ; numout=Да
   (setq ExitNumFun T numout nil oneobj nil numtext nil number1 nil number2 nil numfunction nil numresult nil textprecision nil)
 ) ; if
      )
      ((and (member oneobj '("Выход" "D")) (null numresult)) ; oneobj=Выход
       (setq ExitNumFun T numout nil oneobj nil numtext nil number1 nil number2 nil numfunction nil textprecision nil)
      )
    ) ; cond(Выход)
; Назначение аргументов для вычислений.
   (if (null number1)
     (setq number1 numtext numtext nil) ; первый аргумент
     (setq number2 numtext numtext nil) ; второй аргумент
   ) ; if(number1)
; Функция выполнения вычислений.
  (if (and (not(null numfunction))
    (not(null number1))
    (not(null number2))
      ) ; and
    (progn
      (setq numresult (numfunction number1 number2))
      (princ (strcat "\n\t  Результат:  " (rtos number1 2 3) " " numfuntext " " (rtos number2 2 3) " = " (rtos numresult 2 3)))
      (princ)
      (setq number1 numresult number2 nil)
    ) ; progn
  ) ; if(вычисление)
  
) ; while(ExitNumFun)
  
   (setq ExitNumFun nil oneobj nil numtext nil numfuntext nil numfunction nil numresult nil numout nil textprecision nil)
        (setvar "CMDECHO" p_cmdecho)
        (setvar "OSMODE" p_osmode)
        (setvar "BLIPMODE" p_blipmode)
        (setq p_cmdecho nil p_osmode nil p_blipmode nil)
        (princ "\n END")
        (print)
  
) ; defun
;;; ---------------------------------  _Cris-UnfTextStr  ---------------------------------
;;; Функция снимает метки форматирования текстовой строки и возвращает вещественное число
;;; если в начале текста цифра(ы), либо число 0.0 если текст начинается с буквы.
;;; Пример:
;;; (_Cris-UnfTextStr "{\\fArial Narrow|b0|i0|c204|p34;321,456}")
;;; Возвращает: 321.456
;;; --------------------------------------------------------------------------------------
(defun _Cris-UnfTextStr (textstr / startfnum endfnum formatstr)
  (setq startfnum 0 endfnum 0)
  (while (not (null startfnum))
    (setq startfnum (vl-string-search "{\\" textstr))
    (if (not (null startfnum))
      (progn ; _1
        (setq endfnum (vl-string-search ";" textstr startfnum))
        (if (not (null endfnum))
   (progn ; _2
     (setq formatstr (substr textstr (1+ startfnum) (1+ (- endfnum startfnum)))
           textstr (vl-string-subst "" formatstr textstr startfnum)
           textstr (vl-string-subst "" "}" textstr startfnum))
     (setq endfnum 0 formatstr nil)
   ) ; progn_2
        ) ; if(endnum)
 (setq startfnum 0)
      ) ; progn_1
    ) ; if(startnum)
  ) ; while(not (null startnum)
  (atof (vl-string-translate "," "." textstr))
  ;(princ (strcat "\n Текст объекта: " (rtos numtext 2 3))) (princ)
) ; defun_Cris-UnfTextStr
;;; --------------------------------------------------------------------------------------
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 13.02.2008, 18:25
#43
Олег К.

Инженер-теплотехник
 
Регистрация: 17.08.2006
Смоленск
Сообщений: 307


Сейчас АКАД заново загрузил, исходная версия v4.3 тоже нормально работает, разве что угловой размер не исключается. В #41 я малость дуговой и угловой размеры перепутал. Вообще, для углового размера можно сделать пересчет из радиан в единицы чертежа, но думаю не стоит мешать линейные и угловые величины.

Кстати, это может быть выложено в "Готовые программы"? Если да - нужно в некоторых местах до ума довести, нет - и так сойдет.
Олег К. вне форума  
 
Непрочитано 13.02.2008, 19:49
#44
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Правь и выкладывай. Я в версию 4.3 как раз и добавил обработку дугового размера и исключил из обработки угловой
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Автор темы   Непрочитано 13.02.2008, 21:11
#45
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,980
Отправить сообщение для Red Nova с помощью Skype™


Благодарю. Хорошо сделано.
У меня есть предложение объединить хорошие стороны лиспов выложенных на этом форуме. Есть лисп выложенный Олегом (textcalc4.3) и лисп с поста 16, взятый с сайта caduser.
Перечислю положительные стороны каждого (ИМХО).

textcalc4.3 – есть возможность работать не только с текстом и мтекстом, но и с размерами используя одну команду. Есть возможность контроля количества цифр после запятой.

лисп с поста 16 – Процесс выполнения действий упрощен, можно минимальным затратами времени сосчитать сумму текстов (я еще более его упростил, избавившись от вылетающего окна с содержанием суммы вычисления). Еще тут радует возможность не поштучного выбора, а группового (рамкой).

Как бы я хотел чтоб выглядел финальный лисп.
При всех достоинствах лиспа от Олега должен сказать, что постоянная нужда выбора подкоманд сбивает с толку, и нет возможности выбрать насколько объектов рамкой. На данный момент я использую оба лиспа. Создал несколько копий Лиспа с поста 16, в них поменял команды вызова и каждому задал определенную функцию ( + - * / ). Фактически нужными для меня оказались команды складывания и умножения. Для работы с размерами я пользуюсь программой от Олега. Олег создал очень интересную программу, с возможностью в процессе вычислений менять функцию, но как показывает практика важнее чтоб команда работала быстро.
Предлагаю создать облегченную программу, состоящую из четырех команд (по команде на функцию), без запросов на подфункции. Знаю некоторые возможности созданные Олегом пропадают, но цель в убыстрении процесса вычислений.

То есть команда после вызова работает так. (пример для суммирование)
-выберите объекты,
выбираем размеры или тексты которые нужно просуммировать (выбор возможен и рамкой и поштучно), enter,
-выберите объект для записи значения,
выбираем размер или текст, enter, (здесь как альтернативу enter-у думаю уместно разместить подменю по поводу округления, после чего опять-таки выбираем объект для записи, enter,)
Процесс окончен. Если вы заметили количество действий сведено к минимуму.
При этом количество цифр после запятой (округление) предлагаю по умолчанию оставить 1, для других случаев можно оставить запрос от 0 до 9.
Надеюсь такой переделанный вариант программы приемлем для Олега, как для автора textcalc.

P.S. textcalc и без предложенных мною изменений рекомендую в “Готовые программы”

Последний раз редактировалось Red Nova, 14.02.2008 в 14:55.
Red Nova вне форума  
 
Непрочитано 14.02.2008, 10:14
#46
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Вот мой аналог #16. Правда результат пишет в новый текст, но это поправимо. Из особенностей:
Разбирает Мтексты по параграфам,
Безразличен к . или , в разделителе
Остальное в коментариях
Код:
[Выделить все]
;|============= Команда SumT ================================== 
  Назначение:  Суммирование Тектса,Мтекста, Размеров указанием или рамкой.
               Угловые размеры игнорируются
  Особенности: Безразлична к разделителям точка или запятая. 
               Ввиду особенности работы atof стоки вида "22.3мама" 
               будут учтены как число 22.3
 
               При выводе результата число округляется в соответствии 
               с текущими установками переменной LUPREC. Команда _UNITS 
|; 
(defun c:sumT ( / res selset ins_pt txt_height blk obj ed *error*)
  (defun *error* (msg)
    (setvar "NOMUTT" 0)  ;_ Восстанавливаем NOMUTT
    (princ msg)
    )
 (vl-load-com)(setq res 0.)
 (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 (+ res (apply '+ (mapcar 'atof str))))
     )
       )
      ) ;_ end of foreach 
    ) ;_ end of if 
  (princ "\nРезультат=")(princ (rtos res 2)) 
  (if (not (equal res 0. 1e-3)) 
    (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))) ;_ end of progn
        (progn ;; фиксированнная высота
          (vl-cmdf "_.TEXT" "0,0" 0 txt (rtos res 2))) ;_ end of progn
         )
      (command "_.copybase" "0,0" (entlast) "" "_.erase" (entlast) "" "_.pasteclip" pause) 
      ) ;_ end of progn 
    ) ;_ end of if 
   (princ) 
  ) 
(princ "\nНаберите в командной строке SumT")
(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
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 14.02.2008 в 19:17. Причина: Без запроса Select object:
VVA вне форума  
 
Непрочитано 14.02.2008, 10:36
#47
Олег К.

Инженер-теплотехник
 
Регистрация: 17.08.2006
Смоленск
Сообщений: 307


На самом деле textcalc может и быстрее работать. В начале выбираем Функция > + > enter и щелкаем подряд на текстах. Есть программа для суммирования, получена урезанием textcalc-v3.2, но там нет размеров и вывода в текст, только в комстроку.

Насчет доработок буду думать.
Выбор поштучно или рамкой. Если использовать ssget, то сразу после запроса "Выберите тексты:" вылазит "Select objects:" и от этого никак не избавиться. Мне такое не нравится. А вот при entsel'e пользователь более-менее точно знает в какой именно текст он ткнул. По некоторым причинам не хочу использовать vla-функции. Подумаю, что-нить изобрету.
Запрос на кол-во цифр после запятой: "Выберите объект для записи значения [Опции] <Назад>: ". В опциях выбор кол-ва цифр, не зашел в опции - по умолчанию =1.

Неплохо бы посмотреть как оформлять готовые программы. VVA или kpblc, ссылку на пример не дадите? Вы вроде собирались эти разделы (программы и функции) к единому виду приводить.

Добавлю. Да, можно сделать выбор объектов оптом. Все хорошо, когда используются операции сложения или умножения. А каким образом при "-" и "/" выбрать из набора из чего вычитается и что делится? По-любому первый элемент вычислений придется выбирать отдельно от последующих. Получается три разных программы надо: общая(???), + и *, - и /.

Последний раз редактировалось Олег К., 14.02.2008 в 14:27. Причина: думал
Олег К. вне форума  
 
Непрочитано 14.02.2008, 19:34
#48
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


>Олег К. Там в основном говорилось как оформлять готовые ф-ции. Пример- любая ф-ция в разделе "Программирование->Библиотека функций"
В преамбуле при оформлении готовых программ нужнро описать для чего применяется, какие-то нюансы и органисения. (типа округление чисел из переменной LUPREC, угловые размеры не обрабатываются и т.п.). Дать возможный вариант макроса на кнопочку.
Как пример см. здесь
Проблема с запросом "Select objects:" тоже решаема, см. новый вариант кода с #46. Там этого запроса нет. Думаю с тем как это сделано разберешься.
Так что, как говорится, "Даешь много хороших и разных программ"
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Автор темы   Непрочитано 15.02.2008, 20:02
#49
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,980
Отправить сообщение для Red Nova с помощью Skype™


VVA Жду вариант с возможностью вписать в текст или размер полученный результат. А в этой программе тоже можно сделать из + скажем * при помощи замены кокой–то строчки? Еще очень хотелось бы возможность поиграть с округлением.

Олег.К Честно говоря умножение или отнятие мне ни разу не приходилось использовать (на случай если с ними не получится). Еще в твоей программе плохо то что на моем компьютере (и дома и на работе) не получается мышкой выбрать подменю, команда норовит закончить вычисление. Приходится Клавой работать.
Red Nova вне форума  
 
Непрочитано 18.02.2008, 09:55
#50
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Цитата:
Сообщение от Red Nova Посмотреть сообщение
А в этой программе тоже можно сделать из + скажем * при помощи замены кокой–то строчки?
Так уже раньше где-то показывали. Рецепт не поменялся. Ищем строку
res (+ res (apply '+ (mapcar 'atof str)))) и (apply '+ меняем на (apply '*
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 18.02.2008, 11:20
#51
dextron3

проектировшик
 
Регистрация: 01.01.2007
СССР
Сообщений: 5,143


VVA, не могу понять для чего размеры суммировать, и где это может пригодиться
__________________
инженер проектировшик с опттом программа авто гад образование высшие
dextron3 вне форума  
 
Непрочитано 18.02.2008, 14:42
#52
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


> dextron3 Это спрашивай не у меня, а у Red Nova
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 18.02.2008, 15:27
#53
dextron3

проектировшик
 
Регистрация: 01.01.2007
СССР
Сообщений: 5,143


Red Nova, поделись где этот лисп суммирование размеров применять будешь,
я реально не могу найти ему применение...

Буду благодарен
__________________
инженер проектировшик с опттом программа авто гад образование высшие
dextron3 вне форума  
 
Автор темы   Непрочитано 18.02.2008, 16:03
#54
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,980
Отправить сообщение для Red Nova с помощью Skype™


Был у меня тут чертеж, где некоторые размеры переписаны (длинная цепочка), а сверху цепочки надо проставлять общий размер, равный сумме всех переписанных, вот и возникла идея, что если отметить сразу все размеры, суммировать их значения, можно результат вписать в общий размер.
Red Nova вне форума  
 
Непрочитано 18.02.2008, 16:22
#55
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Пробуйте. Команды
SumTN - суммирование тестов в новый текст
sumTE - суммирование тестов в существующий текст
mulTN - умножение тестов в новый текст
mulTE - умножение тестов в существующий текст
Команды суммирования/умножения в существующий текст (sumTE, mulTE) могут вставлять полученный результат в текст, размер, атрибут блока, заполненную ячейку таблицы.
Вложения
Тип файла: lsp sumT.LSP (7.8 Кб, 755 просмотров)
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Автор темы   Непрочитано 18.02.2008, 22:21
#56
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,980
Отправить сообщение для Red Nova с помощью Skype™


VVA, Попал в точку, то что нужно. Быстро и удобно. Спасибо.
С вопросом разобрались.
Теперь хочу предложить кое что посложнее. Как насчет полноценного калькулятора, способного работать с содержанием мтекста, размеров, длин отрезков, площадей замкнутых линий и штриховок и т.п. (выбор объектов происходит как в лиспе с поста 55)?
Или уж совсем извращенная мысль. Я пользуюсь numlock калькулятором, может есть вариант его заставить видеть объекты AutoCAD-а?
Допускаю что может на этот раз меня занесло, и идеи абсурдные, но было–бы здорово.
Red Nova вне форума  
 
Непрочитано 18.02.2008, 22:33
#57
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


Red Nova, у тебя какой версии AutoCAD?
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 18.02.2008, 23:25
#58
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,980
Отправить сообщение для Red Nova с помощью Skype™


2008, если ты про встроенный калькулятор хочешь сказать, то у него возможности ограниченные.
Red Nova вне форума  
 
Непрочитано 19.02.2008, 09:52
#59
Олег К.

Инженер-теплотехник
 
Регистрация: 17.08.2006
Смоленск
Сообщений: 307


>> VVA Ну и программка! Куда уж мне теперь лезть!
>> Red Nova По #56. Эт конечно интересно когда надо посмотреть разницу реальной длины объекта и того, что на размере указано. Хотя не совсем понимаю зачем, это в свойствах размера посмотреть можно.
Для подсчета длин линий тут программок разных до фига было, ничего изобретать не надо.
Для площадей замкнутых фигур и штриховок есть команда AREA.
В общем, попробуете объяснить зачем это все в одну кучу сгребать. У меня фантазия не развитая.
Олег К. вне форума  
 
Автор темы   Непрочитано 19.02.2008, 10:15
#60
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,980
Отправить сообщение для Red Nova с помощью Skype™


Цитата:
Для площадей замкнутых фигур и штриховок есть команда AREA.
Я больше скажу, на этом сайте есть прога Geometrical Properties, с ней еще удобнее.
А смысл в том, чтоб иметь калькулятор, в который можно вместо цифр ввести любое значение меры длины или там еще чего из AutoCAD. Нечто похожее на встроенный калькулятор, но с расширенными возможностями выбора объектов (у встроенного только длина отрезка, угол и координаты). Я часто использую Numlock калькулятор, для спецификаций (с мтекстом правда благодаря Олег К. и VVA разобрались), и других целей, когда в калькулятор вводишь вместо цифр параметры объектов AutoCAD. Разве у вас такого не было?
Вопрос сейчас не в том чтоб узнать конкретный параметр (длина, площадь, сумма мтекстов…), для этой цели инструментов вроде как достаточно, а в том, чтоб значение этого параметра быстро ввести в калькулятор.
Red Nova вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Как сосчитать сумму цифр из отдельных мтекстов (и лисп для подсчета спецификаций)

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


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