[Drweb]

Парни, довольно срочно нужно изменить все отметки съемки на одну и ту же величину (отметки просто в виде текста), есть ли уже готовое решение?

[VVA]

skkkk, Так точно. Вариант с обработкой Мтекста и сносом форматирования

Код:

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

(defun c:plus (/ *error* adoc value str zpt prec newstr prec1)
  (defun *error* (msg)
    (vla-endundomark adoc)
    (princ msg)
    (princ)
    ) ;_ 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)))
          ((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
		   (zerop (strlen Text))
		   (= " " (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)  
(defun getcount (str / count pat i maxlen ch)
    (setq count 0)
    (setq pat '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))
    (setq i 0 maxlen 0)
         (while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
           (if (vl-position ch pat) ; number
             (setq maxlen (1+ maxlen))
             (setq count  (max count maxlen) maxlen 0)
           )
         )
  (max count maxlen)
  )
  (defun IsAllCharNumeric  ( str / translit)(vl-load-com)  
;;;  http://www.autocad.ru/cgi-bin/f1/board.cgi?t=28488Sx
;;;  Соответствие символов взято с translit.ru
;;;  по мотивам 
;;;  name - исходная строка 
;;;  возвращается преобразованная
  (apply 'and
  (mapcar '(lambda(x)
             (vl-position x '("1" "2" "3" "4" "5" "6" "7" "8" "9" "0" "."))
             )
          (mapcar 'chr (vl-string->list (vl-string-trim  "%UuoO \t" str)))
          )
         )
)
  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-startundomark
  (if
    (and
      (setq selset (ssget "_:L" '((0 . "*TEXT"))))
      (member
        (type (setq
                value (vl-catch-all-apply
                        '(lambda () (getreal "\nСколько добавлять <Отмена> : "))
                        ) ;_ end of vl-catch-all-apply
                ) ;_ end of setq
              ) ;_ end of type
        (list 'int 'real)
        ) ;_ end of member
      ) ;_ end of and
    (progn
     (setq prec1 0)
     (setq newstr (abs value)
	   newstr (- newstr (fix newstr)))
     (while (not (equal newstr (fix newstr) 1e-9))
       (setq prec1 (1+ prec1)
            newstr (* newstr 10))
	     )
     (foreach ent (mapcar
                    'vlax-ename->vla-object
                    (vl-remove-if 'listp (mapcar 'cadr (ssnamex selset)))
                    ) ;_ end of mapcar
       
       (setq zpt (vl-string-search "," (setq str (mip_MTEXT_Unformat(vla-get-textstring ent)))))
       (setq str (vl-string-translate "," "." str))
       (if (setq prec (vl-string-search "." str))
	  (setq prec (getcount (substr str (1+ prec))))
	  (setq prec nil)
	 )
       (cond ((and
	      (null prec)
	      (> prec1 0)
	      )
	      (setq prec prec1)
	      )
	     ((and (numberp prec)
		   (numberp prec1)
		   )
	      (setq prec (max prec prec1))
	      )
	     (t (setq prec nil))
	     )
       (if (IsAllCharNumeric  str)
	 (progn                ;_Нужно было progn добавить
	 (setq newstr  (+ (atof str) value))
	 (setq newstr
		(cond
		    ((numberp prec)(rtos newstr 2 prec))
		    (t (itoa (fix newstr)))
		  )
	       )
         (vla-put-textstring ent
	   (if zpt (vl-string-translate "." "," newstr) newstr))
	 (vla-put-color ent 3) ;_Цвет 3 - зеленый
	 )                     ;_Нужно было progn закрыть
         ) ;_ end of if
       ) ;_ end of foreach
      )	 
     ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

[skkkk]

Спасибо, VVA, работает 100%

[Avodo]

Ребят а можно наоборот упростить ? Очень прошу, напишите код. мне нужно сразу к нескольким текстам числовым прибавить или отнять натуральное число 1 или 2 и т.д. для работы со схемами в связке выноска+поле. В лиспе не силен и горю совсем по сроку. Заранее бьюсь лбом в пол. Числа используются натуральные: 1, 7, 26, и т.д. Без дробей и нулей

[SetQ]

Код:

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

;;;
;;; Shift.lsp
;;; 7 октября 2008 г.
;;; автор http://dwg.ru/f/member.php?u=10868
;;; прибавляет целое число к текстам
;;;
(DeFun C:Shift (/ ss z N i lst txt)
  (Prompt "Выберите тексты : ")
  (If (SetQ ss (ssget '(
			(-4 . "<OR")
			(0 . "TEXT")
			(0 . "MTEXT")
			(-4 . "OR>")
		       )
	       )
      )
    (ProgN
      (InitGet 1)
      (SetQ z (GetInt "\nДельта:")
	    N (ssLength ss)
	    i 0
      )
      (While (< i N)
	(If
	  (NumberP
	    (SetQ i   (1+ i)
		  lst (EntGet (ssName ss i))
		  txt (Read (Cdr (Assoc 1 lst)))
	    )
	  )
	   (EntMod
	     (SubSt
	       (Cons 1 (rtos (+ txt z)))
	       (Assoc 1 lst)
	       lst
	     )
	   )
	)
      )
    )
  )
  (prin1) ;_ BB
)

[Avodo]

Спасибо. про не числовые жаль, но хоть так

[SetQ]

подправил, фильтрует нечисловые..

[kshatriy]

Сообщение от CB >dextron3 Например так: Код: [Выделить все] (defun c:test (/ sys-var selset action value precision_value str precision_str rec-pat ) (defun rec-pat (str / rec-pat) (defun rec-pat (temp str pat n /) (cond ((= str "") (list temp)) ((if (minusp n) (not (member (substr str 1 1) pat)) (member (substr str 1 1) pat) ) ;_ end of if (if (/= temp "") (cons temp (rec-pat "" str pat (- n))) (rec-pat "" str pat (- n)) ) ;_ end of if ) (t (rec-pat (strcat temp (substr str 1 1)) (substr str 2) pat n ) ;_ end of trim_gap ) ) ;_ end of cond ) ;_ end of defun (rec-pat "" str '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9" ".") 1 ) ;_ end of rec-pat ) ;_ end of defun (setq sys-var (getvar 'dimzin)) (setvar 'dimzin 0) (if (and (setq selset (ssget "_:L" '((0 . "TEXT")))) (not (vl-catch-all-error-p (vl-catch-all-apply '(lambda () (setq action (progn (initget "+ - * /") (cadr (assoc (getkword "Действие [+ - * /] :<+> " ) ;_ end of getkword '(("+" +) ("-" -) ("*" *) ("/" /) (nil +)) ) ;_ end of assoc ) ;_ end of cadr ) ;_ end of progn ) ;_ end of setq (setq value (getreal "\nЧисло <Esc> : ")) (setq precision_value ((lambda (x) (if (equal x 0.0) 0 (- (length (vl-string->list (vl-princ-to-string x ) ;_ end of vl-princ-to-string ) ;_ end of vl-string->list ) ;_ end of length 2 ) ;_ end of - ) ;_ end of if ) ;_ end of lambda (rem value 1.) ) ) ;_ end of setq ) ;_ end of lambda ) ;_ end of vl-catch-all-apply ) ;_ end of vl-catch-all-error-p ) ;_ end of not ) ;_ end of and (foreach ent (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex selset))) ) ;_ end of mapcar (setq str (vla-get-textstring ent)) (vla-put-textstring ent (apply 'strcat (mapcar '(lambda (str) (setq precision_str (length (cdr (member 46 (vl-string->list str))) ) ;_ end of length ) ;_ end of setq (if (equal (rtos (atof str) 2 precision_str) str) (rtos ((eval action) (atof str) value) 2 (apply 'max (list precision_value precision_str)) ) ;_ end of rtos str ) ;_ end of if ) ;_ end of lambda (rec-pat str) ) ;_ end of mapcar ) ;_ end of apply ) ;_ end of vla-put-textstring (vla-put-color ent 3) ) ;_ end of foreach ) ;_ end of if (setvar 'dimzin sys-var) (princ) ) ;_ end of defun

Помогите пожалуйста! делю числа 2200 и 400 на 1000 получаю 2 и 0 соответственно, требуется 2.200 и 0.400. как настроить точность? (чтоб ответ автоматически вставлялся с требуемой точностью)

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

Код:

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

_$ (/ 2200 1000)
2
_$ (/ 2200. 1000)
2.2
_$ (/ 2200. 1000.)
2.2
_$ (/ 2200 1000.)
2.2

[kshatriy]

Сообщение от Кулик Алексей aka kpblc Код: [Выделить все] _$ (/ 2200 1000) 2 _$ (/ 2200. 1000) 2.2 _$ (/ 2200. 1000.) 2.2 _$ (/ 2200 1000.) 2.2

как применить?

[VVA]

Сообщение от kshatriy как применить?

Могу предположить, что делишь не лиспом, раз такой вопрос. Тогда зайди в команду _UNITS и выставь нужную точность

[kshatriy]

VVA:делю лиспом из поста 32
лисп и видео прикрепил...
поправьте если что-то делаю не так
AutoCAD 2009rus

[Do$]

Вот тут вот причина:

Код:

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

        (setq
   precision_value
    ((lambda (x)
       (if (equal x 0.0)
         0
         (- (length
       (vl-string->list
         (vl-princ-to-string
    x
         ) ;_ end of vl-princ-to-string
       ) ;_ end of vl-string->list
     ) ;_ end of length
     2
         ) ;_ end of -
       ) ;_ end of if
     ) ;_ end of lambda
      (rem value 1.)
    )

Надо как-то поправить, пока не придумал как.
Попробуй подели не на 1000, а на 1000.001

[kshatriy]

Сообщение от Do$ Попробуй подели не на 1000, а на 1000.001

получилось как надо! 2.200 и 0.400
за это спасибо!

[Do$]

Решил задачку "в лоб"
участок кода из поста #52 замени на:

Код:

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

(setq  precision_value (getint "\nКоличество знаков после запятой:"))

А до кучи еще строчку:

Код:

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

"Действие [+ - * /] :<+> "

На строчку:

Код:

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

"Действие:[+/-/*//]<+>"

Добавил еще метку конца-начала и функцию *error*. В общем файл прикрепил.
Есть, правда, одно "но": если количество знаков после запятой у какого-нибудь из выбранных чисел на чертеже больше, чем введенное значение, то у результата будет столько же знаков после запятой.
Пример: выбраны числа "15" "23.5" "123.234", на запрос "Количество знаков после запятой:" введено "4", тогда у всех результатов будет 4 знака после запятой.
если же выбраны числа "15.3456" "23.84597" "8974" и введено "4", у всех результатов будет 4 знаков после запятой, кроме второго. Не знаю, хорошо это или плохо

[kshatriy]

Do$: Спасибо огромное РАБОТАЕТ!а с дополнением намного лудше!
небольшой вопрос:
когда точность уменьшается (если задаем количество знаком меньше чем было у данного числа до изменения) то почему-то изначальное количество знаков остается:

было 2.200(3 знака) делим на 10 ставим 2 знака после запятой,(остается всеравно 3 знака) в чем проблема?

[Do$]

Я ж выше как раз об этом написал
Там в программе сравнивается точность исходного числа и введенная и которая больше, та и берется. Можно эту проверку легко исключить. Надо?

[kshatriy]

Глаза дырявые...проглядел)
проверка Нужна! а сложно в код добавить команду для удаления незначимых нулей ?

[Do$]

Вроде бы получилось, попробуй.
P.S. Добавил удаление точки.

[kshatriy]

Do$: Спасибо! нули удаляются а разделитель остается (его бы тоже удалять):
было 0.19 умножил на 1000 ,число знаков любое, результат 190.

[Do$]

#58 перезалил