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

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Помогите усовершенствовать макрос суммирования

Помогите усовершенствовать макрос суммирования

Ответ
Поиск в этой теме
Непрочитано 19.02.2021, 08:07 #1
Помогите усовершенствовать макрос суммирования
MrBrown
 
Регистрация: 26.06.2009
Сообщений: 286

Здравствуйте!
Отличный макрос, годами работавший у меня в разных автокадах, оказывается, не способен суммировать Мтексты, выполненные ГОСТовскими шрифтами, например, GOST 2.304
Помогите "допилить" его в нужном направлении, ибо сам - профан.
Если возможно, чтобы ему, на будущее, были по зубам числовые значения вообще любых шрифтовых стилей (арабские цифры).
Спасибо.
p.s. AutoCAD 2020

Вложения
Тип файла: lsp Sum.lsp (509 байт, 10 просмотров)


Последний раз редактировалось MrBrown, 19.02.2021 в 08:13.
Просмотров: 478
 
Непрочитано 19.02.2021, 08:23
1 | #2
Кулик Алексей aka kpblc
Moderator

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


Ищи на форуме очистку от форматирования (кажется, StripMText называлось)
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 19.02.2021, 08:28
#3
MrBrown


 
Регистрация: 26.06.2009
Сообщений: 286


Кулик Алексей aka kpblc, Моя тебе благодарность, ушёл гулять по форуму, скоро вернусь.
MrBrown вне форума  
 
Автор темы   Непрочитано 19.02.2021, 09:49
#4
MrBrown


 
Регистрация: 26.06.2009
Сообщений: 286


Вернулся.
Что-то не работает. Да, макрос StripMText форматирование удаляет, но макрос Sum всё равно не работает.
Он не суммирует даже в случае, если стиль Мтекста поменять вручную на Standart.
Приложил фрагмент чертежа.
Надо макросом Sum суммировать зелёный столбик, чтобы в ком. строке получить фиолетовое значение.
А, может, дело в автокаде 2020?
Просто в прежних автокадах (с 2000 по 2016) проблем с этим макросом не было, и я не обращал внимания на стиль суммируемых Мтекстов.
Вложения
Тип файла: dwg
DWG 2010
123.dwg (101.1 Кб, 12 просмотров)
MrBrown вне форума  
 
Непрочитано 19.02.2021, 10:13
#5
Кулик Алексей aka kpblc
Moderator

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


Почему не использовать таблицу - тайна, ну да ладно. Уже достаточно давно на основании кода, кажется, от VVA (могу ошибаться) сваял такой кодик:
Код:
[Выделить все]
 (defun _kpblc-string-clear-format (mtext / text str pos) ;|
*    Снятие форматирования строки многострочного текста
|;
  (setq text "")
  (while (/= mtext "")
    (cond ((= (strcase (substr mtext 1 3)) "%<\\")
           (setq text  (strcat text (substr mtext 1 (setq pos (vl-string-search ">%" mtext))))
                 mtext (substr mtext pos)
           ) ;_ end of setq
          )
          ((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))))
          )
          ((or (wcmatch (strcase (substr mtext 1 4)) "\\PQ[CRJD],\\PX[QTI]")
               (wcmatch (strcase (substr mtext 1 3)) "\\P[IT]")
           ) ;_ end of or
;;;Add by KPblC
           (setq mtext (substr mtext (+ 2 (vl-string-search ";" mtext))))
          )
          ((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
Вроде срабатывает нормально. Ну а дальше уже совсем неинтересно:
Код:
[Выделить все]
 (defun _kpblc-conv-selset-to-ename (selset / tab item)
  (if (= (type selset) 'pickset)
    (repeat (setq tab  nil
                  item (sslength selset)
            ) ;_ end setq
      (setq tab (cons (ssname selset (setq item (1- item))) tab))
    ) ;_ end repeat
  ) ;_ end of if
) ;_ end of defun

(apply (function +)
       (mapcar (function
                 (lambda (x) (atof (_kpblc-string-clear-format (vla-get-textstring (vlax-ename->vla-object x)))))
               ) ;_ end of function
               (_kpblc-conv-selset-to-ename (ssget '((0 . "*TEXT"))))
       ) ;_ end of mapcar
) ;_ end of apply
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 19.02.2021, 10:37
#6
MrBrown


 
Регистрация: 26.06.2009
Сообщений: 286


Offtop: "Почему не использовать таблицу - тайна"
Не тайна, просто давняя привычка пенсионера. Давно ещё, пару раз попробовал таблицы, не понравилось. Так и забыл про них

Да и с этими кодами не пойму: привык, что коды начинаются "defun c:", а здесь - тю-тю. Как загружать, чтоб работали, без понятия.
MrBrown вне форума  
 
Непрочитано 19.02.2021, 10:49
#7
kacugu

начинающий инженер-гидротехник
 
Регистрация: 18.04.2010
Санкт-Петербург
Сообщений: 787


Цитата:
Сообщение от MrBrown Посмотреть сообщение
Что-то не работает
В Autocad 2016 работает. Взял ваш файл из #4, убрал всё форматирование (проставил все галочки) с помощью StripMtext v5-0c.lsp и ваш лисп отработал нормально
kacugu вне форума  
 
Автор темы   Непрочитано 19.02.2021, 11:58
#8
MrBrown


 
Регистрация: 26.06.2009
Сообщений: 286


kacugu, Благодарю, ушёл пробовать.

----- добавлено через ~5 мин. -----
kacugu, да, всё получилось.
Уважаемые форумчане, благодарю всех за содействие!
Offtop: И, по-видимому, всё же придётся освоить работу с таблицами. Уж очень много народу их хвалит.

Последний раз редактировалось MrBrown, 19.02.2021 в 12:09.
MrBrown вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Помогите усовершенствовать макрос суммирования

Реверс. Автоматическая пакетная печать множества рамок (форматов) из пространства модели и листов
Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Макрос автоматической штриховки замкнутой полилинии MrBrown Программирование 16 29.04.2014 15:02
Автокад 2014 макрос для функции rEconcile. Valery Brelovsky Программирование 2 18.03.2014 10:44
Создать макрос для самостоятельного выбора элементов в чертеже rtyu Программирование 2 11.03.2014 14:57
Помогите написать макрос для разрыва отрезков и полилиний в AutoCad Green4x Программирование 2 01.12.2013 21:03
Прошу мастеров LISP сделать макрос, автоматически рисующий котлованы Малявка LISP 6 20.04.2013 12:06