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

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

Возникла необходимость в суммировании большого количества чисел и забивать каждое число в формулу очень нудно и долго

Ответ
Поиск в этой теме
Непрочитано 10.06.2006, 16:52
Возникла необходимость в суммировании большого количества чисел и забивать каждое число в формулу очень нудно и долго
Макс Тал.
 
строитель
 
СПб.
Регистрация: 13.03.2005
Сообщений: 216

Кто поможет воплотить идею в реальность?
Нужен лисп.
Охото чтобы команда спрашивала
1. Выберите числа, которые необходимо сложить.
2.После выделения запрос на место размещения результата.
3. Вставка результата.
Возникла необходимость в суммировании большого количества чисел и забивать каждое число в формулу очень нудно и долго.
У меня есть лисп который прибавляет к выделенным числам величину, которую указываешь в командной строке при запросе.
Просмотров: 30355
 
Непрочитано 14.08.2006, 10:27
#21
Тим

инженер
 
Регистрация: 27.04.2006
Ростов-на-Дону
Сообщений: 33


Все нормально, заработала, но задача немножко в другом:
Это все можно и в Excele делать, таблицы, спецефикации и т.д, но возникает иногда необходимость сложить (умножить) группу цифр, расположенных на чертеже между собой.
Единственная цель энтого действа, не перебивать все значения, полученные в результате так сказать черчения, потом на калькуляторе.
Примерный алгоритм выполнения:

1 Выберите числа над которыми необходимо произвести действие;
(рамкой выделяется группа чисел, над которыми хочется поглумится)
2 Укажите значение текста, подлежащее редактированию;
(командой DDEDIT редактируется имеющийся однострочный текст)

Примерно такая прога имеется:

(defun c:CalcTXTVal(/ nab i)
(print "Выберите текстовые объекты среди которых будет произведененна калькуляция")
(setq nab (ssget '((0 . "TEXT")))
i 0)
(while (/= (sslength nab) 0)
(setq i (+ i
(atof (vl-string-subst
"."
","
(cdr (assoc 1 (entget (ssname nab 0))))))))
(ssdel (ssname nab 0) nab))
(print (strcat "Сумма = " (rtos i 2 2)))
(princ))

Только здесь сумма выводится в командную строку, а хотелось бы сразу на экран.
И для удобства 2 программы, отдельно, для умножения и сложения.
Тим вне форума  
 
Непрочитано 14.08.2006, 10:49
#22
Лентяй

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,392


Не въехал. То, что выбранные чила можно складывать между собой, это понятно. Но перемножать...[sm2100] Может. все-таки каждое число из выбранной группы умножить на некий постоянный множитель? Проясните, плз. Пока что - держите сложение всего вместе.
Код:
[Выделить все]
(defun C:SumTxt ( / adoc ass txt str val) 
  (setq adoc (vla-get-ActiveDocument (vlax-get-acad-object))        
        ass (vla-get-ActiveSelectionSet adoc) val 0)
  (if (> (vla-get-count ass) 0) (vla-clear ass))
  (vla-selectOnScreen ass (vlax-safearray-fill (vlax-make-safearray vlax-vbinteger '(0 . 0)) '(0)) 
    (vlax-safearray-fill (vlax-make-safearray vlax-vbvariant '(0 . 0)) (list "Text")))
  (if (> (vla-get-count ass) 0)(progn      
    (vlax-for txt ass
      (if (not (wcmatch (setq str (vla-get-TextString txt)) "*@*,*-*,*/*"))
        (progn (if (wcmatch str ",") (setq str (vl-string-subst "," "." str)))
          (setq val (+ val (atof str))))));vlax-for
    (setq txt (vla-addText (if (= (getvar "CVPORT") 2) (vla-get-ModelSpace adoc) (vla-get-PaperSpace adoc));if
                (rtos val 2 2) (vla-getPoint (vla-get-utility adoc) nil "Укажите точку вставки текста") 1.0))
    (mapcar '(lambda (x y) (vlax-put-property txt x y)) (setq txpr '(Layer Color Height StyleName ScaleFactor))
      (mapcar '(lambda (z) (vlax-get-property (vla-item ass 0) z)) txpr)));progn
    (alert "Ни фига не выбрано!"));if
);end
Лентяй вне форума  
 
Непрочитано 14.08.2006, 12:06
#23
Тим

инженер
 
Регистрация: 27.04.2006
Ростов-на-Дону
Сообщений: 33


Ну да, с умножением я грубанул, много числов конечно не нужно перемножать, нужно всего два
выбрать одно
выбрать второе
получить результат
Тим вне форума  
 
Непрочитано 14.08.2006, 12:17
#24
Лентяй

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,392


А вставлять- то куды? (Гусары, молчать!) Я имею в вижу - вместо первого, второго, или в указанное курсором место? Держите универсалбный вариант.
Код:
[Выделить все]
(defun C:MultTxt ( / adoc util txt txt1 txt2 str1 str2 opt val) 
  (setq adoc (vla-get-ActiveDocument (vlax-get-acad-object)) 
        util (vla-get-utility adoc) val 0) 
  (if (apply 'and (mapcar '(lambda (x y) (not (vl-catch-all-error-p (vl-catch-all-apply 
        		'(lambda () (vla-getentity util x nil (strcat "Выберите " y " число")))))))
                    '(txt1 txt2) '("первое" "второе")));apply
     (if (apply 'and (mapcar '(lambda (x) (= (vla-get-objectname x) "AcDbText")) (list txt1 txt2)))
       (progn (setq str (mapcar '(lambda (x) (vla-get-TextString x)) (list txt1 txt2)))
         (if (apply 'and (mapcar '(lambda (x) (not (wcmatch x "*@*,*-*,*/*"))) str)) (progn
             (setq val (apply '* (mapcar '(lambda (x)
               (atof (if (wcmatch x ",") (setq x (vl-string-subst "," "." x)) x))) str)));setq
          (vla-InitializeUserInput util 128 "Первое Второе Новое") 
          (if (null opt0) (setq opt0 "Новое")) 
          (setq opt (vla-getKeyword util (strcat "Заместить число [Первое/Второе/Новое] <" opt0 ">: "))) 
          (if (= opt "") (setq opt opt0) (setq opt0 opt))
          (cond ((= opt "Первое") (vla-put-TextString txt1 (rtos val 2 2)))
                ((= opt "Второе") (vla-put-TextString txt2 (rtos val 2 2)))
                ((= opt "Новое")
                 (setq txt (vla-addText (if (= (getvar "CVPORT") 2) (vla-get-ModelSpace adoc) (vla-get-PaperSpace adoc));if
                             (rtos val 2 2) (vla-getPoint util nil "Укажите точку вставки текста") 1.0))
                 (mapcar '(lambda (x y) (vlax-put-property txt x y)) (setq txpr '(Layer Color Height StyleName ScaleFactor))
                   (mapcar '(lambda (z) (vlax-get-property txt1 z)) txpr)))));progn
         (alert "\nЭто не число! Разуй глаза и выбери снова!")));progn
       (alert "\Это не текст! Выбирай внимаельнее"));if
    (alert "Пара не выбрана!"));if
);end
Лентяй вне форума  
 
Непрочитано 14.08.2006, 21:28
#25
Тим

инженер
 
Регистрация: 27.04.2006
Ростов-на-Дону
Сообщений: 33


Огромное спасибо товарищу Лентяю за проявленное терпение и оказанную помощь, как расплачиваться буду прямо не знаю, может подскажешь?
И кстати вопрос: "Где находится граница между помощью и коммерцией, какого уровня сложности задачи решаются уже за денги?"
Тим вне форума  
 
Непрочитано 14.08.2006, 22:28 Lisp для суммирование длин выделенных линий
#26
vyachek


 
Сообщений: n/a


Lisp для суммирование длин выделенных линий - однажды на просторах инета встретил описание такого лиспа, но нигде не мог найти исходника. Может у кого-нибудь есть? :?: :shock:[[/b]
 
 
Непрочитано 14.08.2006, 23:03 Перевед
#27
DEM

YngIngKllr
 
Регистрация: 29.03.2005
СПб
Сообщений: 12,976


На Автокад.ру смотри в готовых программах или лиспе.
Щас нет времени искать.
__________________
Работаю за еду.
Working for food.
Für Essen arbeiten.
العمل من أجل الغذاء
Працую за їжу.
DEM вне форума  
 
Непрочитано 15.08.2006, 10:54
#28
Лентяй

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,392


Цитата:
Сообщение от Тим
Огромное спасибо товарищу Лентяю за проявленное терпение и оказанную помощь,
Всегда пожалуйста! Не забывайте только денно и нощно сугубо и трегубо благодарить меня. любимого, за то, что я есть.
Цитата:
как расплачиваться буду прямо не знаю, может подскажешь?
Натурой :twisted:
Цитата:
И кстати вопрос: "Где находится граница между помощью и коммерцией, какого уровня сложности задачи решаются уже за денги?"
Помощь - это когда получаешь работу за бесплатно, ну, типа, как любовь - это когда получаешь за бесплатно секс. :twisted: :twisted:
Лентяй вне форума  
 
Непрочитано 28.09.2006, 11:30
#29
Олег К.

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


Сам пишу подобную прогу, нашел эту тему и решил добавить свои размышления (надеюсь, тему еще кто-то просматривает).
ACAD2006, в качестве стандартного шрифта у нас используется Arial Narrow. При взятии числа из текста с помощью конструкции:
(setq numtext (atof (vl-string-translate "," "." (vla-get-textstring (vlax-ename->vla-object (car (entsel "\n Укажите текст:")))))))
возникает проблема с русскими символами, а точнее упорно выдает число 0.0 если раньше вместо цифр был какой-либо русский текст (типа: взяли MText с русскими буквами, скопировали его и заменили текст на число). Как ни странно такого не происходит если меняется латиница на число или создан новый MText с вводом числа в русской раскладке (запятая то, по идее, русским шрифтом пишется). Entget на русский текст выдает (1 . "{\\fArial Narrow|b0|i0|c204|p34;12.5}"), для сравнения латиница: (1 . "10,2"), или еще вариант: (1 . "qwerty {\\fArial Narrow|b0|i0|c204|p34;йцукен qwerty}").
Если кто знает, как получить содержимое текста без записей форматирования, УМОЛЯЮ, напишите.
Кстати, попробовал прогу от Лентяя (пост №24) – отказывается воспринимать второе число, говорит “это не текст”, попробовал выбрать числа в обратном порядке – та же фигня.
Извините что так длинно, не удивлюсь, если ответ на мою просьбу уместится в одной строке.
Олег К. на форуме  
 
Непрочитано 28.09.2006, 12:11
#30
VVA

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


1.http://www.autocad.ru/cgi-bin/f1/board.cgi?t=20905TQ
2.StripMtext v3.07
3. Может так по
Код:
[Выделить все]
(setq txt "{\\fArial Narrow|b0|i0|c204|p34;12.5}") 
(setq num (VL-STRING-TRIM "{}" (if (cadr(setq num (str-str-lst  txt ";")))(cadr num)(car num))))
Ф-ция str-str-lst
VVA вне форума  
 
Непрочитано 28.09.2006, 16:17
#31
Олег К.

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


Огромное спасибо, что подсказали где искать. Да-а, ответ действительно одной строкой . Понравилась программа от Kpblc’а, но объем великоват, так что применил функцию str-str-lst. У меня на компе работает замечательно, попробовал на другом – снова ошибки. В этот раз текст “793,44” записан в виде: (1 . "793{\\fArial Narrow|b0|i0|c204|p34;,}44"). И как теперь разделить мух с котлетами вообще не представляю, может есть у кого простое решение?
Олег К. на форуме  
 
Непрочитано 28.09.2006, 16:29
#32
Кулик Алексей aka kpblc
Moderator

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


Код:
[Выделить все]
_$ (kpblc-string-mtext-unformat "793{\\fArial Narrow|b0|i0|c204|p34;,}44")
"793,44"
На всякий случай код (потому как я там что-то менял достаточно давно).
Код:
[Выделить все]
;|=============================================================================
*    Функция сносит форматирование многострочного текста. Удаляются символы "{"
* и "}", поскольку именно символ "}" является окончанием применения определенного
* фонта. Удаляются наборы типа {fTimes New Roman|b0|i0|c204|p18; и т.п.
*    Параметры вызова:
*	string-to-normalize	- строка, которую надо нормализовать
*    Примеры вызова:
(_kpblc-clear-mtext (cdr (assoc 1 (entget(car(entsel))))))
	; для выбранного многострочного текста очищает форматирование.
=============================================================================|;
(defun _kpblc-clear-mtext	(string-to-normalize		     /
			 sub_string	   sub_pos	     left_string
			 right_string
			 )
  (if (or
	(setq sub_pos (vl-string-search "{f" string-to-normalize))
	(setq sub_pos (vl-string-search "{\\" string-to-normalize))
	(setq sub_pos (vl-string-search "\\f" string-to-normalize))
	(setq sub_pos (vl-string-search "{\\f" string-to-normalize))
	) ;_ end of or
    (progn
      (setq left_string			;все, что до "{"
	     (substr
	       string-to-normalize
	       1
	       sub_pos
	       ) ;_ end of substr
	    ) ;_ end of setq
      (vl-catch-all-error-p
	(setq right_string		;все, что между {f и ;
	       (substr
		 string-to-normalize
		 (+ (vl-string-position (ascii ";") string-to-normalize sub_pos) 2)
		 ) ;_ end of substr
	      ) ;_ end of setq
	) ;_ end of vl-catch-all-error-p
      (setq sub_string (strcat left_string right_string))
      (if (setq sub_pos (vl-string-search "}" sub_string))
	(setq sub_string
	       (strcat
		 (substr sub_string 1 sub_pos)
		 (substr sub_string (1+ sub_pos))
		 ) ;_ end of strcat
	      ) ;_ end of setq
	) ;_ end of if
      (_kpblc-clear-mtext sub_string)
      ) ;_ end of progn
    (vl-string-trim "}" string-to-normalize)
    ) ;_ end of if
  ) ;_ end of defun
;|=============================================================================
*    Функция очистки форматирования многострочного текста. Не гарантируется,
* что найдены все варианты форматирования. Также заменяет все переводы строк
* на "\n"
*    Параметры вызова:
*	ent	Текстовая строка, с которой надо снять форматирование
*    Исходный код взят с ruCAD, без переделок.
=============================================================================|;
(defun kpblc-string-mtext-unformat (ent			  /
				    _tmp		  _substr
				    _mtext-str-extractor-clr
				    _mtext-str-extractor-clr
				    )
  (defun _mtext-str-extractor-clr (str / _pos)
    (if	(setq _pos (_mtext-str-extractor-srch
		     str
		     '("{\\" "\\f" "\\F")
		     ) ;_ end of _mtext-str-extractor-srch
	      ) ;_ end of setq
      (strcat
	(if (> _pos 0)
	  (substr str 1 _pos)
	  ""
	  ) ;_ end of if
	(_mtext-str-extractor-clr
	  (substr
	    str
	    (+ 2 (vl-string-search ";" str (1+ _pos)))
	    ) ;_ end of substr
	  ) ;_ end of _mtext-str-extractor-clr
	) ;_ end of strcat
      str
      ) ;_ end of if
    ) ;_ end of defun
  (defun _mtext-str-extractor-srch (str lst / _tmp)
    (car (vl-sort
	   (vl-remove-if
	     'not
	     (mapcar (function (lambda (_x _y)
				 (vl-string-search _y _x)
				 ) ;_ end of lambda
			       ) ;_ end of function
		     (repeat (length lst)
		       (setq _tmp (cons str _tmp))
		       ) ;_ end of repeat
		     lst
		     ) ;_ end of mapcar
	     ) ;_ end of vl-remove-if
	   '<
	   ) ;_ end of vl-sort
	 ) ;_ end of car
    ) ;_ end of defun
  (setq
    _tmp (vl-string-subst
	   ""
	   "}"
	   (_mtext-str-extractor-clr
	     (_kpblc-string-replace
	       (_kpblc-string-replace
		 (_kpblc-string-replace
		   (_kpblc-string-replace
		     (_kpblc-string-replace
		       (_kpblc-string-replace
			 ent
					;) ;_ end of vla-get-textstring
			 "\\\\"
			 ""
			 ) ;_ end of _kpblc-string-replace
		       "\\{"
		       (chr 1)
		       ) ;_ end of _kpblc-string-replace
		     "\\}"
		     (chr 2)
		     ) ;_ end of _kpblc-string-replace
		   "\\P"
		   "\n"
		   ) ;_ end of _kpblc-string-replace
		 "\\L"
		 ""
		 ) ;_ end of _kpblc-string-replace
	       "\\l"
	       ""
	       ) ;_ end of _kpblc-string-replace
	     ) ;_ end of _mtext-str-extractor-clr
	   ) ;_ end of vl-string-subst
    ) ;_ end of setq
  (while
    (and (setq _substr (_kpblc-string-cut-between _tmp "\\" ";" nil))
	 (/= _substr "")
	 ) ;_ end of and
     (setq _tmp (vl-string-subst "" _substr _tmp))
     ) ;_ end of while
  (vl-string-subst "}" (chr 2) (vl-string-subst "{" (chr 1) _tmp))
  _tmp
  ) ;_ end of defun

;|=============================================================================
*    Функция замены вхождений подстроки в исходную строку на новые.
* Регистрозависимо
*    Параметры вызова:
*	string		исходная строка
*	ols_substr	старая подстрока
*	new_substr	новая подстрока
*    Примеры вызова:
(_kpblc-string-replace "Здесь были ВаВася и ВаВаВаня. Вася" "Ва" "Бу")
	; "Здесь были Буся и Буня. Буся"
=============================================================================|;
(defun _kpblc-string-replace (string old_substr new_substr / pos)
  (while (setq pos (vl-string-search old_substr string))
    (setq string
           (strcat
             (substr string 1 pos)
             new_substr
             (_kpblc-string-replace
               (substr string (+ (strlen old_substr) pos 1))
               old_substr
               new_substr
               ) ;_ end of _kpblc-string-replace
             ) ;_ end of strcat
          ) ;_ end of setq
    ) ;_ end of while
  string
  ) ;_ end of defun
Функции в значительной части слизаны с ruCAD'a
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 28.09.2006, 17:20
#33
VVA

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


А если так
Код:
[Выделить все]
(defun mknum (str / pat str1 lst num)
  (setq pat (VL-STRING->LIST "{}"))
  (setq str1 (VL-LIST->STRING (mapcar '(lambda (x)(if(member x pat) 003 x))(VL-STRING->LIST str))))
  (setq lst (str-str-lst str1 (chr 003)))
  (VL-STRING-TRANSLATE "," "."
  (apply 'strcat (vl-remove-if 'null (mapcar '(lambda (x)(if (cadr(setq num (str-str-lst x ";")))(cadr num)(car num))) lst))))
) ;_  defun
str-str-lst та же
Пример
Код:
[Выделить все]
(setq txt "793{\\fArial Narrow|b0|i0|c204|p34;,}44")
(mknum txt) -> "793.44"

(setq txt "{\\fArial Narrow|b0|i0|c204|p34;12.5}")
(mknum txt) -> "12.5"

(setq txt "{\\fArial Narrow|b0|i0|c204|p34;1}2{\\fArial Narrow|b0|i0|c204|p34;,}5")
(mknum txt) -> "12.5"
VVA вне форума  
 
Непрочитано 28.09.2006, 17:32
#34
Кулик Алексей aka kpblc
Moderator

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


> VVA : Думаю, тебе пригодится такое (для определения текущего разделителя):
Код:
[Выделить все]
;|
*    Возвращает значение десятичного разделителя
|;
(defun _kpblc-reg-decimal-separator-get	()
  (vl-registry-read
    "HKEY_CURRENT_USER\\Control Panel\\International"
    "sDecimal"
    ) ;_ end of vl-registry-read
  ) ;_ end of defun
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 28.09.2006, 18:01
#35
VVA

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


Протестируйте такое. В принципе тоже что и у тебя, но компактнее
;;;Снятие формата с MTEXT
;;; Mtext - строка Мтекта типа "793{\\fArial Narrow|b0|i0|c204|p34;,}44"
;;;Возврат - строка без форматирования
Код:
[Выделить все]
(defun Unformat ( Mtext / text )
  (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
  )
Пример

Код:
[Выделить все]
(setq txt "{\\fArial Narrow|b0|i0|c204|p34;Воздухозаборная
\\fArial Narrow|b0|i0|c0|p34;\{\\fArial Narrow|b0|i0|c204|p34;решетка \\fArial Narrow|b0|i0|c0|p34;\}
{\\fArial Narrow|b0|i0|c204|p34;900х600 (\\fArial Narrow|b0|i0|c0|p34;h\\fArial Narrow|b0|i0|c204|p34;)
на отм.2,600}")
(unformat txt) -> "Воздухозаборная\nрешетка \n900х600 (h)\nна отм.2,600"
VVA вне форума  
 
Непрочитано 29.09.2006, 00:43
#36
KAI

геологоразведка, строительство
 
Регистрация: 14.10.2003
Магадан
Сообщений: 311


Тестируем в Acad2007:
Код:
[Выделить все]
Command: (unformat txt)
"Воздухозаборная \n;;;решетка  \n;;;900х600 (h) \n;;;на отм.2,600"
Вроде как лишние точки с запятой.
KAI вне форума  
 
Непрочитано 29.09.2006, 12:15
#37
Олег К.

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


А тема оказывается популярная. С утра просмотрел сообщения, спасибо всем, что указали “верный путь”. Придумал свой вариант снятия форматирования с текста, работает с однострочным и многострочным текстом, хотя в большом многострочном возможны косяки (один раз встретилось \\fArial Nar… вместо {\\fArial Nar…), не снимаются метки форматирования типа \n, \P, \L и т.п. Проверял на 2006 и 7 АвтоКАДе. Прошу сильно не бить за отсутствие проверок на ошибки, функция изначально задумывалась для одной цели: перевести текст “793,44” (как он выглядит на экране) в число 793.44 для дальнейших вычислений.
Код:
[Выделить все]
;;; -----------------------------  _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))
) ; defun_Cris-UnfTextStr
Олег К. на форуме  
 
Непрочитано 11.10.2006, 16:20
#38
Олег К.

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


В предыдущем сообщении отредактировал функцию снятия форматирования с текста – в таком виде использую ее в “калькуляторе текста”. В принципе этот калькулятор работает, но хотелось бы улучшить некоторые места. Поэтому очень прошу подсказать ответы на следующие вопросы, или дать ссылки на темы обсуждений (долго ковырял поиском этот форум и на AutoCAD.ru но ничего полезного не выловил).
1. Функция ssget : как избавиться от запроса “Select objects: ” ?
2. Функция initget используется в таком варианте:
(initget "Число Функция Результат Выход X A H D _X A H D X A H D")
(setq oneobj (entsel "\n Укажите текст или [ Число / Функция / Результат / Выход]: "))
- такой initget прописал, когда дал протестировать программу опытному пользователю и мне был задан вопрос “Почему я должен вводить команды только на русском? Может я не знаю какая раскладка включена, должна понимать и английский вариант.” Так вот, есть ли способ попроще (ну или покрасивше) заставить пользователя вводить только нужные мне данные (ткнуть текст или выбрать опцию)?
3. Этот вопрос является продолжением предыдущего. В ответ на запрос функции entsel можно ввести “L” и будет повторен последний выбор. Я то могу сказать юзерам “это не баг, это фича”, но самому же интересно как оно проскакивает мимо initget’a ??
4. Можно ли программно, но не через конструкцию (vl-cmdf "_.-layer" "_U" "имя слоя" "") разблокировать слой? Информацию о состоянии слоя беру из таблицы слоев через (cdr (assoc 70 (tblsearch "LAYER" textlayer))).
Простите, если вопросы покажутся глупыми, я ведь только учусь (а больше спрашивать то и некого) и заранее спасибо за ответы.

Кстати, вопрос Модератору: не пора ли поменять название темы, скажем на “калькулятор текста”, или подобное? Так сказать, чтобы будущие поколения программистов могли быстрее найти нужную информацию.
Олег К. на форуме  
 
Непрочитано 12.10.2006, 10:09
#39
Лентяй

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,392


Цитата:
Сообщение от Олег К.
4. Можно ли программно, но не через конструкцию (vl-cmdf "_.-layer" "_U" "имя слоя" "") разблокировать слой? Информацию о состоянии слоя беру из таблицы слоев через (cdr (assoc 70 (tblsearch "LAYER" textlayer)))
Можно средствами ActiveX, о преимуществах которых я здесь уже устал повторять.
Код:
[Выделить все]
(setq lyrs (vla-get-layers (vla-get-ActiveDocument (vlax-get-acad-object))); Получаем объект - коллекцию слоев
      lyr (vla-item lyrs "textlayer")); Получаем объект - слой с именем "textlayer"
(if (= (vla-get-lock lyr) :vlax-true) (vla-put-lock lyr :vlax-false)); Проверяем, заблокирован ли этот слой и снимаемблокировку
Лентяй вне форума  
 
Непрочитано 12.10.2006, 11:39
#40
VVA

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


1. Функция ssget : как избавиться от запроса “Select objects: ” ?
(ssget "_X" фильтр) http://www.afralisp.net/lispa/lisp19.htm
Самое полное описание в Vlisp'e F1
2. Если речь все-таки идет об опциях команды.
Пусть пользователь объяснит тебе и нам, если он видит приглашение
"Укажите текст или [ Число / Функция / Результат / Выход]: "
Какой английский вариант он имеет ввиду? И почему английский, а не немецкий? Пусть почитает F1->Руководство полизователя->Пользовательский интерфейс->Окно команд->Ввод команд в командной строке->Задание опций команд. Это правило.
3. Вызови команду _MOVE. В ответ на запрос "Выберите объекты:" набери "qwe". Автокад ругнется и выдаст
Цитата:
*Неверный выбор*
Требуется точка или
Рамка/Последний/Секрамка/БОКС/Все/Линия/РМн-угол/СМн-угол/Группа/Класс/Добавить/
Исключить/Несколько/Текущий/Отменить/Авто/Единственный
Это способы выбора объектов.
То же если в ответ на запрос (entsel) ввести "qwe" получим
Цитата:
*Неверный выбор*
Требуется точка или Последний
Последний - он же "_Last". Это не баг, это фича - это норма, просто не все знают.
VVA вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Возникла необходимость в суммировании большого количества чисел и забивать каждое число в формулу очень нудно и долго

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

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