Увеличение всех отметок на определенную величину

Drweb · 22.11.2007, 11:47

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

Малявка · 21.05.2008, 12:50

skkkk, посмотри здесь:
http://www.caduser.ru/cgi-bin/f1/board.cgi?t=42402mx
и здесь:
http://dwg.ru/f/showthread.php?t=20686
Буквально вчера ребята мне помогли решить ту же задачу и даже с фенечкой, которую я попросила. До сих пор прыгаю от счастья.
Может этот код тебе поможет. Удачи.

VVA · 21.05.2008, 12:52

Нужное выделил красным

Код:

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

(defun c:plus (/ *error* adoc value str)
  (defun *error* (msg)
    (vla-endundomark adoc)
    (princ msg)
    (princ)
    ) ;_ end of defun

  (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
     (foreach ent (mapcar
                    'vlax-ename->vla-object
                    (vl-remove-if 'listp (mapcar 'cadr (ssnamex selset)))
                    ) ;_ end of mapcar
       (if (equal (rtos (setq str (atof (vl-string-translate "," "."(vla-get-textstring ent)))))
                  (vl-string-translate "," "."(vla-get-textstring ent))
                  ) ;_ end of equal
	 (progn                ;_Нужно было progn добавить
         (vla-put-textstring ent (rtos (+ str value) 2 2))
	 (vla-put-color ent 3) ;_Цвет 3 - зеленый
	 )                     ;_Нужно было progn закрыть
         ) ;_ end of if
       ) ;_ end of foreach
     ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

dextron3 · 26.05.2008, 10:49

VVA, спасибо,
буду рад модификации

1. Не работает с дробными числами пример 1.213
2. Хочется чтобы был выбор сколько добавлять, сколько отнять, на что умножить, и на что разделить
3. Про изменние цвета это хорошо
4. Самое главно если текст записан так L=400мм, а мы добавили 50, то все оставалось тоже а число было таким L=450мм,

п. 4. ну очень нужная вещь при редактировании спецификации
к примеру поменялась длинна плиты на 50мм стало меньше, пощелкал по спеке откорректировал за минуту вот и хорошо

skkkk · 30.05.2008, 20:00

>dextron3
1.С дробными числами он может работать, есть маленькая хитрость. Нужно точность luprec выставить на столько, сколько у тебя знаков после запятой, в твоем случае - 3. Это можно сделать:
а) из командной строки (_luprec>3);
б) в меню Формат->Единицы (Format->Units) установить точность на 0.000;
в) вставить строку
(command "luprec" 3);;; 3 знака после запятой
в начало лиспа ПОСЛЕ строчки
(defun clus (/ *error* adoc value str). Точность будет меняться автоматически. Если надо вернуть старое значение luprec, то поставь ту же строку ПЕРЕД
) ;_ end of defun только измени цифру 3 на нужную. Предполагаю, это не вполне грамотно, ведь я не особый знаток, использовал метод тыка, но у меня работает

2. За функцию (+-/*) отвечает знак в строке
(vla-put-textstring ent (rtos (+ str value) 2 2)), правда придется делать четыре лиспа, и это будет четыре разные команды (например: plus, minus, umn, razd,- не забудь поменять вместе с арифметическим знаком команду в лиспе, ну и для приличия надпись "Сколько добавлять" смени как надо), и можно сделать четыре кнопки с макросами
^C^C(if(null Clus)(Load "plus.lsp"));plus;, "plus" меняешь, разумеется. Лиспы должны быть в путях доступа (Сервис->Настройка->Файлы). Можно сделать выпадающие кнопки.
3. Согласен.
4. Есть лисп, который добавляет префикс и суффикс. Он тут: http://forum.dwg.ru/showthread.php?t=10596
Для удобства можешь сделать кнопку с макросом
^C^C(if(null C:AddPS)(Load "Add Prefix Suffix.lsp"));AddPS;L=;мм;, она автоматом вставит "L=" и "мм", останется только выбрать тексты, опять же, не забудь про пути доступа.

Попробуй пошарить в поиске по слову "field", есть возможность делать так, чтобы при изменении длины линии автоматом менялось значение текста в "спеке"
P.S.: Смайлики с языками читай как двоеточие и латинская P

skkkk · 30.05.2008, 21:09

Убрал за отсутствием актуальности

CB · 31.05.2008, 16:17

Если по пунктам 1-3 можно так:

Код:

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

(defun c:test (/ selset action value precision_value str precision_str)
  (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))
       (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)
  (progn ;_Нужно было progn добавить
    (vla-put-textstring
      ent
      (rtos
        ((eval action) (atof str) value)
        2
        (apply 'max (list precision_value precision_str))
      ) ;_ end of rtos
    ) ;_ end of vla-put-textstring
    (vla-put-color ent 3) ;_Цвет 3 - зеленый
  ) ;_Нужно было progn закрыть
       ) ;_ end of if
     ) ;_ end of foreach
  ) ;_ end of if
  (princ)
) ;_ end of defun

dextron3 · 31.05.2008, 16:29

CB,(т.е. по моим пунктам)

CB · 02.06.2008, 12:02

>dextron3

Да по твоим пунктам...
Правда чтобы все правильно работало и по требованиям поста 14 нужно чуть изменить программу:

Код:

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

(defun c:test (/ sys-var selset action value precision_value str precision_str)
(setq sys-var (getvar 'dimzin))
(setvar 'dimzin 0)
  (if
    (and
      (setq selset (ssget "_:L" '((0 . "TEXT"))))
...............................................................
  ) ;_ end of if
  (setvar 'dimzin sys-var)
  (princ)
) ;_ end of defun

Сделать прогу по условиям п.4 тоже можно, вот пример (правда достаточно коряво написано...) :

Код:

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

(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
 
;;;Вызов (rec-pat "L=150.57мм") -> ("L=" "150.57" "мм")

Остается за малым - проанализировать получившийся список на предмет нахождения в нем числа, выполнить с числом действие и снова соединить список с помощью (apply 'strcat '("L=" "150.57" "мм"))

dextron3 · 02.06.2008, 12:49

Код:

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

(defun c:test (/ sys-var selset action value precision_value str precision_str)
(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))
       (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)
  (progn ;_Нужно было progn добавить
    (vla-put-textstring
      ent
      (rtos
        ((eval action) (atof str) value)
        2
        (apply 'max (list precision_value precision_str))
      ) ;_ end of rtos
    ) ;_ end of vla-put-textstring
    (vla-put-color ent 3) ;_Цвет 3 - зеленый
  ) ;_Нужно было progn закрыть
       ) ;_ end of if
  (setvar 'dimzin sys-var)
  (princ)
) ;_ end of defun

error: malformed list on input

CB · 02.06.2008, 13:32

Код:

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

...............................................
  ) ;_Нужно было progn закрыть
      ) ;_ end of if
    ) ;_ end of foreach
 ) ;_ end of if
 (setvar 'dimzin sys-var)
 (princ)
) ;_ end of defun

dextron3 · 02.06.2008, 13:39

CB, Отличный лиспец получился!, но только для обыкновенных цыфр

всетаки куда (rec-pat "L=150.57мм") именно для этого лиспа вставить чтобы только числа выискивал?

CB · 02.06.2008, 17:18

>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

dextron3 · 02.06.2008, 18:20

CB, отлчино! спасибо, его теперь использую в правке спецификаций...

skkkk · 05.08.2008, 18:51

Лисп с #22 не увеличивает числа, в которых десятичный разделитель - запятая. Можно исправить?? Спасибо

VVA · 05.08.2008, 20:53

skkkk, Выделил фиолетовым в #22

skkkk · 05.08.2008, 21:28

Спасибо, VVA, только вот после обработки запятая меняется на точку....Можно, чтоб запятая оставалась? И еще не знаете, как исправить ситуацию в этом лиспе, описанную мной в #14, чтобы не зависело от переменной luprec? Т.е., чтобы после обработки лиспом текст был с тем же разделителем и с тем же количеством знаков после него, как и исходный. Так мне для каждой задачи приходится делать отдельный лисп и прописывать в нем значение luprec в зависимости оттого, сколько там знаков после запятой (или точки)

VVA · 05.08.2008, 23:15

skkkk, Пробуй
Текст должен оставаться с тем же разделителем как исходный.
Количество знаков определяется как максимальное количество знаков после запятой у обрабатываемого в данный момент текста и введенного числа. Например:
текст 2 , число 0.1 - будет округляться до 1 знака после запятой
текст 2.12 , число 0.1 - будет округляться до 2 знаков после запятой
текст 2 , число 1 - будет округляться до 0 знаков после запятой

Код:

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

(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 . "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 (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                ;_Нужно было 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 · 05.08.2008, 23:31

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

... Только вот в прилагаемом файле желтый текст не обрабатывается. Видимо, из-за того, что он имеет некое форматирование??

stroygeodezia · 06.08.2008, 00:04

Мои "творения" на чистом LISP'е без всяких "vlax'ов"

Код:

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

;--------------------------------------------------------------------------
; Изменение отметок топосъемки на слое "Отметки"
;--------------------------------------------------------------------------
(DEFUN C:EDIT_Z ( / delta_z )
 (SETVAR "CMDECHO" 0)
 (SETQ delta_z  (GETSTRING "На какое значение изменить отметки: "))
 (SETQ n (GETSTRING "Количество знаков точности: "))

 (SETQ list_z (SSGET "X" '((0 . "TEXT")(8 . "Отметки"))))
 (SETQ len (SSLENGTH list_z))
 (SETQ c 0)
 (IF (> len 0)
   (PROGN
     (WHILE (< c len)
       (SETQ ename (SSNAME list_z c))
       (SETQ name_z (ENTGET ename))
       (IF (= (cdr (ASSOC 0 name_z)) "TEXT")
          (SETQ old_z  (ASSOC 1 name_z)
                old (CDR old_z)
                new (+ (ATOF old) (ATOF delta_z))
                new_z  (CONS 1 (RTOS new 2 (ATOI n )) )
                name_z (SUBST new_z old_z name_z)
          )
       )
       (ENTMOD name_z)
       (SETQ c (1+ c))
     )
   )
 )
 (SETVAR "CMDECHO" 1)
 (PRIN1)
)

;--------------------------------------------------------------------------
; Выборочное изменение отметок топосъемки
;--------------------------------------------------------------------------
(DEFUN C:EDIT_Z_SEL ( / delta_z )
 (SETVAR "CMDECHO" 0)
 (PROMPT "\nВыбери изменяемые отметки:")
 (COMMAND "_SELECT" pause)
 (SETQ list_z (SSGET "_p"))

 (SETQ delta_z  (GETSTRING "На какое значение изменить отметки: "))
 (SETQ n (GETSTRING "Количество знаков точности: "))

 (SETQ len (SSLENGTH list_z))
 (SETQ c 0)
 (IF (> len 0)
   (PROGN
     (WHILE (< c len)
       (SETQ ename (SSNAME list_z c))
       (SETQ name_z (ENTGET ename))
       (IF (= (cdr (ASSOC 0 name_z)) "TEXT")
          (SETQ old_z  (ASSOC 1 name_z)
                old (CDR old_z)
                new (+ (ATOF old) (ATOF delta_z))
                new_z  (CONS 1 (RTOS new 2 (ATOI n )) )
                name_z (SUBST new_z old_z name_z)
          )
       )
       (ENTMOD name_z)
       (SETQ c (1+ c))
     )
   )
 )
 (SETVAR "CMDECHO" 1)
 (PRIN1)
)

Кулик Алексей aka kpblc · 06.08.2008, 00:29

Я в любой момент нажимаю Esc и AutoCAD будет в каком состоянии? Я в ответ на запрос "На какое значение изменить отметки?" нажимаю Enter и программа вылетает. Или ввожу "А_Не_Надо_ничего_менять" - результат будет там же.

22.11.2007, 11:47
Увеличение всех отметок на определенную величину Drweb Регистрация: 22.11.2007 Сообщений: 10 Парни, довольно срочно нужно изменить все отметки съемки на одну и ту же величину (отметки просто в виде текста), есть ли уже готовое решение?
Просмотров: 42649