[yuryx]

Как с помощью lisp команд на модели AutoCAD 2009/2012: из текст "Сумма 250.000 п.м.",
выбрать "250.000"
С помощью простых команд для последующего вычисления начиная команды:
(setq txt ... (entsel "\nВыбрать тест/мтекст:")...)

[Do$]

С помощью этой функции:
http://forum.dwg.ru/showpost.php?p=285510&postcount=2

[yuryx]

С помощью этой функции:
http://forum.dwg.ru/showpost.php?p=285510&postcount=2

С помощью этой функции мне очень сложно.

[Do$]

Я понял.

Код:

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

 (defun _dwgru-str->list	(s)
			;|
***************************************************************************************
*
* Программа разделяет строку на список текстовых и цифровых составляющих.
* Запятая между цифрами, зменяется на точечный разделитель дробной части.
* 
**************************************************************************************
*
* Написал Елпанов Евгений       (ElpanovEvgeniy)
*
* дата создания (13/10/2007 a 11:42)
* написано во время конкурса на форуме:
* http://www.cadxp.com/XForum+viewthread-fid-101-tid-16943-page-2.html
***************************************************************************************
* Пример использования и результатов работы:
* (_dwgru-str->list "point.25.4cm.")           => ("point." 25.4 "cm.")
* (_dwgru-str->list "point.25,4cm.")           => ("point." 25.4 "cm.")
* (_dwgru-str->list "point.3/8cm.")            => ("point." 0.375 "cm.")
* (_dwgru-str->list "qvf12qsdf125 5sf 56dfv2") => ("qvf" 12 "qsdf" 125 " " 5 "sf " 56 "dfv" 2)
***************************************************************************************
 |;
  (defun str->list1 (a b f)
    (cond
      ((null b)
       (list
	 (if f
	   (cond ((vl-position 46 a) (atof (vl-list->string (reverse a))))
		 ((vl-position 47 a) (distof (vl-list->string (reverse a))))
		 ((vl-position 44 a)
		  (atof (vl-list->string (subst 46 44 (reverse a))))
		 )
		 (t (atoi (vl-list->string (reverse a))))
	   ) ;_ cond
	   (vl-list->string (reverse a))
	 ) ;_ if
       ) ;_ list
      )
      (f
       (if (or (= (car b) 44) (< 45 (car b) 58))
	 (str->list1 (cons (car b) a) (cdr b) f)
	 (cons (cond ((vl-position 46 a) (atof (vl-list->string (reverse a))))
		     ((vl-position 47 a) (distof (vl-list->string (reverse a))))
		     ((vl-position 44 a)
		      (atof (vl-list->string (subst 46 44 (reverse a))))
		     )
		     (t (atoi (vl-list->string (reverse a))))
	       ) ;_ cond
	       (str->list1 (list (car b)) (cdr b) nil)
	 ) ;_ cons
       ) ;_ if
      )
      (t
       (if (< 47 (car b) 58)
	 (cons (vl-list->string (reverse a))
	       (str->list1 (list (car b)) (cdr b) t)
	 ) ;_ end of cons
	 (str->list1 (cons (car b) a) (cdr b) nil)
       ) ;_ if
      )
    ) ;_ cond
  ) ;_ defun
  (setq s (vl-string->list s))
  (str->list1
    (list (car s))
    (cdr s)
    (if	(or (= (car s) 44) (< 45 (car s) 58))
      t
    ) ;_ if
  ) ;_ end of str->list1
) ;_ end of defun

(setq txt     (car (entsel "\nВыбрать тест/мтекст с числом:"))
      eg      (entget txt)
      str     (cdr (assoc 1 eg))
      lst     (_dwgru-str->list str)
      num     (car (vl-member-if 'numberp lst))
      num-str (vl-princ-to-string num)
) ;_ end of setq

[ciril]

Не понимаю, для чего нужно, но куда уж проще

Код:

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

 (defun c:exttxt	 (/ x00 x01 x02 x03)
  (while (not (and (setq x00 (car (entsel "\nВыберите текст...")))
		   (or (eq "TEXT" (cdr (assoc 0 (setq x00 (entget x00))))) (eq "MTEXT" (cdr (assoc 0 x00)))))))
  (setq x00 (cdr (assoc 1 x00)))
  (princ (rtos (read (substr (while (not (eq 32 (ascii x00))) (setq x00 (substr x00 2))) 2))))
  (princ))

Будет работать, если число с двух сторон ограниченно пробелами.

[yuryx]

Выбрать текст на модели AutoCAD "Сумма 250.000 п.м.",
а вернуть "250.000"
С помощью простых команд для последующего вычисления начиная команды:
(setq txt ... (entsel "\nВыбрать тест/мтекст:")...)

Спасибо всем кто не остался стороне.
Очень просто. Для меня сегодня сложно.
Пробел дейсвительно имеет место с двух сторон числа.
Как вставить функцию разделения строки на текст и число?
Число возвращается в этот или аналогично созданный код.

Код:

(defun C:test_txtch ()
(defun txt (_msg) (atof (cdr (assoc 1 (entget (car (entsel _msg)))))))
(while
(setq a (txt "\nВыбрать тест/мтекст:"))
(setq b (txt "\nВыбрать тест/мтекст: "))
(setq txtch (rtos (+ a b) 2 3))
(setq ptst (getpoint "\n Укжите место"))
(command "_text" ptst "" "" txtch)
) ;_ while
(princ)
) ;_ defun
(princ "\n Type then: test_txtch ")

Не обладаю достаточным знанием в lisp.

[Klo]

Советую использовать функцию substr (выделяет подстроку с заданной позиции) и strlen (количество символов в строке).
Сначала в переменную запишите строку до второго пробела, в другую до первого пробела.
К сожалению накидать код сейчас некогда.

[Елпанов Евгений]

_dwgru-str->list

[gomer]

одмины спят, а у мну двоится в глазах?

[Елпанов Евгений]

Если в тексте только одно число, можно:

Код:

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

 (vl-list->string (vl-remove-if-not (function (lambda (a) (or (= a 46) (<= 48 a 57)))) (vl-string->list s)))

можно еще и так:

Код:

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

 (defun f (s) (if (and (wcmatch s"*#*") (wcmatch s "#*")) (atof s) (f (substr s 2))))


(f "aslkfj;las49583asdfj")

[skkkk]

Offtop: Потом кто-то будет читать эту тему, и не поймет, что же Гомер имел в виду...А он, оказывается, увидел в Топ 10 тем две одинаковые. Я сразу и не смекнул, а спустя месяц никто и подавно не поймет

[Кулик Алексей aka kpblc]

yuryx, тебе одной темы мало, что ли? Темы объединены.

[yuryx]

Как правильно оставатся в внутри одной темы?
Я первый день пишу собщения. Не владею темой.

[ciril]

Сообщение от yuryx (while (setq a (txt "\nВыбрать тест/мтекст:")) ;* (setq b (txt "\nВыбрать тест/мтекст: ")) ;** (setq txtch (rtos (+ a b) 2 3)) ;***

Удали * и **, и вместо *** вставь:

Код:

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

 (setq txtch (rtos (+ (exttxt) (exttxt))2 3))

причем exttxt изменится:

Код:

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

 (defun exttxt     (/ x00)
 (while (not (and (setq x00 (car (entsel "\nВыберите текст..."))) 
       (or (eq "TEXT" (cdr (assoc 0 (setq x00 (entget x00))))) (eq "MTEXT" (cdr (assoc 0 x00)))))) (princ "\nТекст не выбран...")) ;выбираешь пока не выберешь примитив и он не текст или мтекст
 (setq x00 (cdr (assoc 1 x00))) ;выделяешь содержимое текста
 (read (substr (while (not (eq 32 (ascii x00))) (setq x00 (substr x00 2))) 2))) ;читаешь строку после первого пробела и возвращаешь полученное значение

не будет работать также, если разделитель разрядов "," или в мтексте форматирование числа отличается от форматирования предыдущей надписи.
В своем коде объяви локальными те переменные, которые используешь и я бы на твоем месте обернул указание точки в цикл:

Код:

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

 (while (not (setq ptst (getpoint "\n Укжите место"))) (princ "\nТочка не указана..."))

И текст лучше создавать не command, а entmake. В этом случае у тебя есть возможность задать слой, на котором будет создаваться текст, ну и другие его свойства. Иначе будет создан на текущем.

[yuryx]

Спасибо Ciril
Ваших сообщениях #5 вижу для себя ценность применительно к своему коду.
Пользуюсь что то получается. Рзмышляю где и как применять.

[yuryx]

Если в тексте только одно число, можно:
можно еще и так:
Код:

[Выделить все]
1 (defun f (s) (if (and (wcmatch s"*#*") (wcmatch s "#*")) (atof s) (f (substr s 2)))) 2 3


4 (f "aslkfj;las49583asdfj")

Если делать как показано выше ?
Если с моим кодом по аналогии, то вот
Код:

(defun C:test3v_txtch ()
;(defun txt (_msg) (atof (cdr (assoc 1 (entget (car (entsel _msg)))))));1v
(defun f (s) (if (and (wcmatch s"*#*") (wcmatch s "#*")) (atof s) (f (substr s 2))));3v
;(defun txt (_msg) (atof (cdr (assoc 1 (entget (car (entsel _msg)))))));1v
(while
(setq a (f "\nÂûáðàòü òåñò/ìòåêñò:"))
(setq b (f "\nÂûáðàòü òåñò/ìòåêñò: "))
(f "aslkfj;las49583asdfj");3v
(setq txtch (rtos (+ a b) 2 3))
(setq ptst (getpoint "\n Óêæèòå ìåñòî"))
(command "_text" ptst "" "" txtch)
) ;_ while
(princ)
) ;_ defun
(princ "\n Type then: test3v_txtch ")

Это так должно быть?
В командной строке получил следующие:

Команда: _appload test3v_txtch.LSP успешно загружено.
Команда:
Type then: test3v_txtch
Команда:
Команда: test3v_txtch
Возникла серьезная ошибка ***
достигнут внутренний предел стека (смоделирован)
Команда:

[ciril]

функция f(s) вызывает переполнение стека, если в строке нет чисел.