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

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Добавление индекса к именам выбранных блоков

Добавление индекса к именам выбранных блоков

Ответ
Поиск в этой теме
Непрочитано 30.10.2009, 13:53 #1
Добавление индекса к именам выбранных блоков
Кочетков Андрей
 
Java/Kotlin backend
 
Регистрация: 03.02.2006
Сообщений: 5,736

Добрый день уважаемые гуру программинга ))
Вновь нужна ваша помощь в автоматизации моей работы в Автокаде:
мне нужна программа которая работает по следующему алгоритму:
1. выделяем объекты
2. программа фильтрует из набора блоки
3. к имени каждого блока добавляется двузначный числовой индекс.
Если индекс уже присутствует, то он увеличивается на один.
Для простоты алгоритма индекс добавляется в конец имени блока и обрамлен символами _$$_

Например в выделение попали два блока:
- один называется BLOCK1
- другой BLOCK2

После обработки программой мы имеем два блока с именами:
BLOCK1_01_
и
BLOCK2_01_

Если еще раз применить эту программу к этому набору, то имена блоков изменятся на:
BLOCK1_02_
и
BLOCK2_02_

Вложенные блоки обрабатываются по такому же алгоритму.


Прошу помочь с данной программой ))
Просмотров: 6533
 
Непрочитано 30.10.2009, 16:13
1 | #2
VVA

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


Цитата:
Сообщение от Кочетков Андрей Посмотреть сообщение
Для простоты алгоритма индекс добавляется в конец имени блока и обрамлен символами _$$_
Для простоты как раз таки удобнее, чтобы последние символы были цифрами. Изменил шаблон на *_$NNN, где NNN - цифры, а _$-маска
Пробуй
Код:
[Выделить все]
;;Block Number Plus
(defun C:BN+ ( / ss i lst doc namelist lst1)
  (vl-load-com)
  (setq lst nil namelist nil lst1 nil)
(if (and  
  (setq doc (vla-get-activedocument (vlax-get-acad-object))
	blks (vla-get-blocks doc)
	)
  (setq ss (ssget '((0 . "INSERT"))))
  (progn
  (repeat
    (setq i (sslength ss)) ;_ end setq
    (setq lst (cons (ssname ss (setq i (1- i))) lst))
    )
  lst
  )
  (setq namelist
	 (mapcar '(lambda(blk)
		    (setq blk (vlax-ename->vla-object blk))
		    (cond 
                     ((and (vlax-property-available-p blk 'isdynamicblock) 
                           (= (vla-get-isdynamicblock blk) :vlax-true) 
                           ) ;_ end of and 
                      (vla-get-effectivename blk) 
                      ) 
                     (t (vla-get-name blk)) 
                     ) ;_ end of cond
		    )
		 lst
		 )
	)
 (setq namelist (vl-remove-if '(lambda(x)
		  (or (not (snvalid x))
		      (eq (vla-get-IsXRef(vla-item blks x)) :vlax-true)
		      )
		 )
   namelist)
       )
(setq namelist (apply 'append (mapcar 'Get-all-nested-block-names namelist)))
(setq namelist (mip_MakeUniqueMembersOfList namelist))
 (setq namelist (vl-remove-if '(lambda(x)
		  (or (not (snvalid x))
		      (eq (vla-get-IsXRef(vla-item blks x)) :vlax-true)
		      )
		 )
   namelist)
       )
  )
  (progn
    (setq lst nil lst1 nil)
    (mapcar '(lambda(y / x)
               (setq y (strcase y) x y)
               (if (not
                    (or (wcmatch x "*_$#")
		       (wcmatch x "*_$##")
		       (wcmatch x "*_$###")
		       (wcmatch x "*_$####")
		       (wcmatch x "*_$#####")
		       (wcmatch x "*_$######")
		       )
                    )
                 (setq x (strcat x "_$1"))
                 )

               (while (or (tblobjname "BLOCK" x)(vl-position x lst1))
                 (setq x (incsuff x 1 nil))
                 )
               
               (setq lst (cons (list y x) lst) lst1 (cons x lst1))
	       )
	    namelist
	    )
    (mapcar '(lambda(x)
               (vl-catch-all-apply '(lambda()
                                      (command "_-RENAME" "_B" (car x)(cadr x))
                                      )
                 )
               )
            lst
            )
  )
 )
  (princ)
)
(defun get-block-name (itm)
  (cond
    ((and (vlax-property-available-p itm 'isdynamicblock)
	  (= (vla-get-isdynamicblock itm) :vlax-true)
     ) ;_ end of and 
     (vla-get-effectivename itm)
    )

    (t (vla-get-name itm))
  )
)

(defun Get-all-nested-block-names (blk / bObj lst)
  (if
    (and
      (setq lst (cons blk lst))
      (not
        (vl-catch-all-error-p
          (vl-catch-all-apply
            (function
              (lambda ( )
                (setq bObj
                  (vla-item
                    (vla-get-blocks
                      (vla-get-ActiveDocument
                        (vlax-get-acad-object))) blk))))))))
    (vlax-for Obj bObj
      (and (eq "AcDbBlockReference"
             (vla-get-ObjectName Obj))
           (setq lst (cons (get-block-name Obj) lst))
           (Get-all-nested-block-names (get-block-name Obj)))))
  lst)
(defun mip_MakeUniqueMembersOfList  ( lst / OutList head)
;;;Удаляет одинаковые (дубликаты) элементы из списка
;;; На основе http://www.theswamp.org/index.php?topic=19128.0
;;; Изменено для сравнения вещественных чисел (equal ... 1e-6)

  (while lst
    (setq head (car lst)
          OutList (cons head OutList)
          lst (vl-remove-if '(lambda(pt)(equal pt head 1e-6))(cdr lst))
          )
    )
  (reverse OutList)
  )
 (defun incsuff (str inc alpha / lst crt pas ind dep quo ret)
;; INCSUFF -Gilles Chanteau- 2008/01/15
;; Adds the specified increment to a string suffix.
;; Is considered as suffix, all [0-9] characters from the end of the string
;; more [A-Z] and [a-z] characters if alpha argument is non nil.
;;
;; Adapting to the Russian alphabet by VVA (Vladimir Azarko)  
;; Arguments
;; str : a string
;; inc : a positive integer
;; alpha : if non nil, [a-z] [A-Z] characters are integrated to suffix.
;;
;; Return
;; The string with incremented suffix (or nil if none valid suffix)
;;
;; Examples :
;; (incsuff "N° 002" 12 T) = "N° 014"
;; (incsuff "Drawing_A" 1 T) = "Drawing_B"
;; (incsuff "test_ZZ9" 1 T) = "test_AAA0"
;; (incsuff "test_ZZ9" 1 nil) = "test_ZZ10"
;; (incsuff "12-" 1 nil) = nil  
  
  (setq lst (reverse (vl-string->list str)))
  (while
    (and
      (setq crt (car lst))
      (cond
        ((< 47 crt 58) ;_Number
         (setq pas 10  ;_Step
               ind 48  ;_ ASCII Code Number 0
         ) ;_ end of setq
        )
        ((and alpha (< 64 crt 91)) ;_Upper case latin
         (setq pas 26              ;_Number of letters in the alphabet (step)
               ind 65              ;_Upper case latin A (eng)
         ) ;_ end of setq
        )
        ((and alpha (< 96 crt 123)) ;_Lower case latin
         (setq pas 26               ;_Number of letters in the alphabet (step)
               ind 97               ;_Lower case latin A (eng)
         ) ;_ end of setq
        )
        ((and alpha (< 191 crt 224));_Upper case russian
         (setq pas 32               ;_Number of letters in the alphabet (step)
               ind 192              ;_Upper case russian A
         ) ;_ end of setq
        )
        ((and alpha (< 223 crt 256));_Lower case russian
         (setq pas 32               ;_Number of letters in the alphabet (step)
               ind 224              ;_Lower case russian A
         ) ;_ end of setq
        )
        ((< 0 quo)
         (setq crt (if (= 10 pas)
                     ind
                     (1- ind)
                   ) ;_ end of if
               lst (cons (car lst) lst)
         ) ;_ end of setq
        )
      ) ;_ end of cond
    ) ;_ end of and
     (setq dep (- crt ind)
           quo (/ (+ dep inc) pas)
           ret (cons (+ ind (rem (+ dep inc) pas)) ret)
     ) ;_ end of setq
     (if (zerop quo)
       (setq ret (append (reverse (cdr lst)) ret)
             lst nil
       ) ;_ end of setq
       (if (cdr lst)
         (setq lst (cdr lst)
               inc quo
         ) ;_ end of setq
         (setq lst (list ind)
               inc (if (= 10 pas)
                     quo
                     (1- quo)
                   ) ;_ end of if
         ) ;_ end of setq
       ) ;_ end of if
     ) ;_ end of if
  ) ;_ end of while
  (if ret
    (vl-list->string ret)
  ) ;_ end of if
)
Если миллиона (6 символов) не хватит, добавляй эти строки (wcmatch x "*_$######")
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 07.11.2009 в 14:23. Причина: орфография
VVA вне форума  
 
Автор темы   Непрочитано 30.10.2009, 19:42
#3
Кочетков Андрей

Java/Kotlin backend
 
Регистрация: 03.02.2006
Сообщений: 5,736


Спасибо, Друг! ))
Я уже дома, ем пироженное и пью чай, поэтому смогу потестить в только понедельник.
Спасибо еще раз! ))
Кочетков Андрей вне форума  
 
Автор темы   Непрочитано 06.11.2009, 13:12
#4
Кочетков Андрей

Java/Kotlin backend
 
Регистрация: 03.02.2006
Сообщений: 5,736


Все работает превосходно!
Спасибо!
Кочетков Андрей вне форума  
 
Непрочитано 23.08.2018, 21:31
#5
posetitel


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


VVA, а есть возможность добавить в лисп выпадающее меню и уже в меню пользователю самому указывать, какие символы приписывать к блокам?
posetitel вне форума  
 
Непрочитано 29.08.2018, 10:02
#6
VVA

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


Проблем в принципе не вижу, но не понятно ТЗ. К каждому блоку спрашивать какие символы добавлять?
Тогда как поступить, ели пользователь ввел символы, а блок с таким именем в чертеже есть?
Как вариант можно шаблон изменить на *_$UUU_NNN, где UUU - часть маски, запрошенная у пользователя?
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 29.08.2018, 10:49
#7
posetitel


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


Суть ТЗ такая:
Есть 10-15 файлов с одинаковыми именами блоков, например: "швеллер", "уголок", "болт" в каждом файле.
Я хочу все файлы объединить в одном общем путем простого копирования. Для этого запускаю лисп в первом файле, меня спрашивают какое имя нужно дописать, я ввожу "01" и все блоки "швеллер", "уголок", "болт" в первом файле становятся "швеллер_01", "уголок_01", "болт_01". Копирую в общий файл. Тоже самое делаю со вторым файлом, только имя присваиваю "02". И т.д.
posetitel вне форума  
 
Непрочитано 29.08.2018, 11:43
#8
Boxa

КЖ; C#
 
Регистрация: 03.11.2005
Санкт-Петербург
Сообщений: 2,588


posetitel, а почему бы просто не внедрить xref... автокад сам допишет название файла к имени блока?
(давно не пользовался этим, но вроде так работало раньше...)
Boxa вне форума  
 
Непрочитано 29.08.2018, 12:01
#9
posetitel


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


в конкретном случае надо свести в один файл путем старого доброго копирования
posetitel вне форума  
 
Непрочитано 29.08.2018, 12:18
#10
Boxa

КЖ; C#
 
Регистрация: 03.11.2005
Санкт-Петербург
Сообщений: 2,588


Вы несколько не поняли, я имел в виду, что получится один файл.
Нужно вставить xref, а потом внедрить его, никаких ссылок не будет (видяшка)
Будет один файл и внутри него блоки с превексами
Boxa вне форума  
 
Непрочитано 29.08.2018, 12:24
#11
posetitel


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


видео мало информативно, но примерно представляю о чем речь идет.
мне же в конкретной данной ситуации надо скопировать из всех файлов в один именно ctrl-c ctrl-v
posetitel вне форума  
 
Непрочитано 29.08.2018, 12:32
#12
Boxa

КЖ; C#
 
Регистрация: 03.11.2005
Санкт-Петербург
Сообщений: 2,588


И чем будет отличаться файл, который Вы соберете переименовав блоки и копипаствнув, от такого же файла, сделанного штатными средствами (внедрение xref, которое сделано именно для того, что бы собирать все в один файл и при этом названия блоков, слоев, стилей и т.д. не смешивались)

В любом случае спасибо, на свой вопрос я ответ получил.
Boxa вне форума  
 
Непрочитано 30.08.2018, 16:29
#13
VVA

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


Переименование решается обычной командой _rename. К коду выше никакого отношения не имеет
Код:
[Выделить все]
(defun C:RB ( / add tablelist)
;;;================================================================================
;;;Written By Michael Puckett. 
;;;Список элементов символьных таблиц АвтоКАДа 
;;; - s- имя таблицы
;;;Пример - список всех слоев - (setq all_layers (tablelist "LAYER"))

    (defun tablelist (s / d r)
      (while (setq d (tblnext s (null d)))
        (setq r (cons (cdr (assoc 2 d)) r))
      );_ while
    );_ defun
;;;End Coding Here	
(setq add (getstring "Новый суффикс: "))
(setvar "CMDECHO" 1)
(foreach blk (tablelist "BLOCK")
  (if (snvalid blk 0)
  (if command-s
    (command-s "_.-RENAME" "_BLOCK" blk (strcat blk "_" add))
    (command "_.-RENAME" "_BLOCK" blk (strcat blk "_" add))
    )
    )
  )
  (princ)
  )
(princ "\nType RB in command line to rename block")
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 31.08.2018 в 08:46.
VVA вне форума  
 
Непрочитано 30.08.2018, 18:35
#14
posetitel


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


Спасибо!
В коде выше, правда, есть возможность переименовывать только выделенные блоки, но и на этом лиспе спасибо.
Мне сейчас гораздо проще все подряд переименовать, чем пижонить с выделением конкретной группы.
posetitel вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Добавление индекса к именам выбранных блоков

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
LISP. Очистка рисунка от "пустых" блоков Makswell Готовые программы 15 26.10.2022 15:24