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

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

Нужна помощь . Приращивание к тексту определного значения .

Ответ
Поиск в этой теме
Непрочитано 23.08.2019, 19:09 #1
Нужна помощь . Приращивание к тексту определного значения .
mdzibuk
 
Регистрация: 23.08.2019
Сообщений: 6

ребят помогите нубу . очень облегчите время .
что хочу:
есть допустим в чертеже число текст допусти 15, нужна лиспа при запуске которой задаешь сколько прирастить допустим 11. потом нажимаешь на число оно меняет значение на 26 на следующее допустим на 18 и оно меняет значение на 29. то-есть типо нумератора.

нажимаешь на нолик оно приращивает 1 только не на блок а на обычный текст. чтоб раставить нолики и нумеровать менять значения. или уже сразу менять нажатиям допустим с определенного числа хз как более яснее объяснить))

и можно еще такую типо есть числа 752 допустим запускаешь лиспу нажимаешь на число, просит вести значение 200 и оно минусует от этого значения заменяя его 552 ставит.


первое нужно занимаюсь инвентаризацией деревьев иногда теряешь парочку и надоедает перенумеровывать по одному выбирать каждое и вводить значение.


а второе растояние между пикетами на сетях газа и если есть врезка нужно делить от одного пикета отнять другое растояние.


Спасите бедного инженера нет времени уже искать(((( или дайте ссылки буду весьма благодарен.
Просмотров: 852
 
Непрочитано 25.08.2019, 11:48
#2
skkkk

AutoCAD_2008->2011
 
Регистрация: 20.03.2008
Московская область
Сообщений: 2,286


Не помню, где это лежит на форуме, но точно помню, что когда-то давно, лет 10 назад, когда я сам еще ничего не умел, kpblc и VVA сделали для меня такую вещь (за что им еще раз огромное спасибо):
Код:
[Выделить все]
 ;;; Увеличение выбранных числовых текстов на заданную величину с изменением цвета текста результата на белый
;;; Авторы kpblc и VVA 
(vl-load-com)
(defun c:plusCOLOR (/ *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)))
          )
         )
)
  
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-startundomark
  (if
    (and
      (setq selset (ssget "_:L" '((0 .  "MTEXT,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 (LM:UnFormat (vla-get-textstring ent) nil))))
       (setq str (vl-string-translate "," "." (LM:UnFormat (vla-get-textstring ent) nil)))
       (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

(defun LM:UnFormat ( str mtx / _replace rx )

    (defun _replace ( new old str )
        (vlax-put-property rx 'pattern old)
        (vlax-invoke rx 'replace str new)
    )
    (if (setq rx (vlax-get-or-create-object "VBScript.RegExp"))
        (progn
            (setq str
                (vl-catch-all-apply
                    (function
                        (lambda ( )
                            (vlax-put-property rx 'global     actrue)
                            (vlax-put-property rx 'multiline  actrue)
                            (vlax-put-property rx 'ignorecase acfalse) 
                            (foreach pair
                               '(
                                    ("\032"    . "\\\\\\\\")
                                    (" "       . "\\\\P|\\n|\\t")
                                    ("$1"      . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")
                                    ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
                                    ("$1$2"    . "\\\\(\\\\S)|[\\\\](})|}")
                                    ("$1"      . "[\\\\]({)|{")
                                )
                                (setq str (_replace (car pair) (cdr pair) str))
                            )
                            (if mtx
                                (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str))
                                (_replace "\\"   "\032" str)
                            )
                        )
                    )
                )
            )
            (vlax-release-object rx)
            (if (null (vl-catch-all-error-p str))
                str
            )
        )
    )
) ;_end of defun (LM:UnFormat)	
Программа, помимо описанного в первом посте, также меняет цвет исправленных текстов на белый (удобно контролировать процесс, если перед этим тексты перекрасить)
Чтобы уменьшить число, надо на запрос "сколько прибавлять" вбить отрицательное чиcло

Последний раз редактировалось skkkk, 28.08.2019 в 02:22.
skkkk на форуме  
 
Автор темы   Непрочитано 25.08.2019, 12:09
#3
mdzibuk


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


спс жалко под нанокад не пашет (( ругаеться ошибка: неверная строка режима SSGET ))
mdzibuk вне форума  
 
Непрочитано 25.08.2019, 22:18
#4
VVA

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


mdzibuk, замени строку
Цитата:
(setq selset (ssget "_:L" '((0 . "MTEXT,TEXT"))))
на
Цитата:
(setq selset (ssget '((0 . "MTEXT,TEXT"))))
или убери "_:L"
Контролировать блокировку слоя будешь самостоятельно

----- добавлено через ~2 мин. -----
skkkk, Ты еще не выложил в #2 функцию LM:UnFormat
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Автор темы   Непрочитано 25.08.2019, 23:14
#5
mdzibuk


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


no function definition: LM:UNFORMA


счас ругаеться))
mdzibuk вне форума  
 
Непрочитано 25.08.2019, 23:58
#6
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 6,984


Цитата:
Сообщение от VVA Посмотреть сообщение
LM:UnFormat
первые же ссылки в поисковике ведут на искомую функцию от Lee Mac
Сергей812 вне форума  
 
Автор темы   Непрочитано 27.08.2019, 18:42
#7
mdzibuk


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


Цитата:
Сообщение от Сергей812 Посмотреть сообщение
первые же ссылки в поисковике ведут на искомую функцию от Lee Mac
так ругаеться что сделать нужно?? можно ли под нанокад подстроить??
mdzibuk вне форума  
 
Непрочитано 27.08.2019, 19:34
#8
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 6,984


Цитата:
Сообщение от mdzibuk Посмотреть сообщение
так ругаеться что сделать нужно??
скачать функцию, добавить в файл лиспа либо закинуть в автозагрузку. Если она есть у нанокада.

Цитата:
Сообщение от mdzibuk Посмотреть сообщение
можно ли под нанокад подстроить??
не в курсе)
Сергей812 вне форума  
 
Непрочитано 28.08.2019, 02:24
#9
skkkk

AutoCAD_2008->2011
 
Регистрация: 20.03.2008
Московская область
Сообщений: 2,286


Цитата:
Сообщение от VVA Посмотреть сообщение
skkkk, Ты еще не выложил в #2 функцию LM:UnFormat
VVA, cпасибо, исправил в #2.
skkkk на форуме  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Нужна помощь . Приращивание к тексту определного значения .

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Нужна помощь в освещении лыжно - роллерной трассы SVic Инженерные сети 13 25.04.2017 15:33
Нужна помощь в настройке экспорта чертежей из Tekla 2016i в DWG. safronsafronov Tekla 2 27.10.2016 09:20
Нужна помощь Николай1 Прочее. Архитектура и строительство 2 27.02.2004 12:47