[shartal]

Есть лисп, найденный, убей не помню где. Он перенумеровывает выноски на указанное значение, но отказывается работать с числами, оканчивающимися на 0 (10,20,30..) Можно ли с ним что-то сделать?

[skkkk]

Сообщение от shartal лисп, найденный, убей не помню где

Думаю, его основа тут Увеличение всех отметок на определенную величину
У меня прикрепленный лисп вообще не работает.
Вот рабочий вариант

Код:

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

;;; Увеличение выбранных числовых текстов, мтекстов и мультивыносок на заданную величину
;;; Автор VVA
(defun c:plus (/ *error* adoc value str zpt prec newstr prec1)
  (defun *error* (msg)
    (vla-endundomark adoc)
    (princ msg)
    (princ)
    ) ;_ end of defun
(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 .  "MTEXT,TEXT,MULTILEADER"))))
      (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 (vla-get-textstring ent))))
       (setq str (vl-string-translate "," "."(vla-get-textstring ent)))
       (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               
     (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 7) ;_Цвет 7 - белый
     )                    
         ) ;_ end of if
       ) ;_ end of foreach
      )     
     ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun