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

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

LISP: Переименование одного из вхождений блока

Ответ
Поиск в этой теме
Непрочитано 19.06.2009, 16:59 #1
LISP: Переименование одного из вхождений блока
Кочетков Андрей
 
Java/Kotlin backend
 
Регистрация: 03.02.2006
Сообщений: 5,736

пару лет назад обсуждалась такая программа.
Сейчас она понадобилась вновь.
Нашел с трудом в старых сообщениях.
Публикую здесь, чтобы было проще найти.

Вариант Alaspher'a:

Код:
[Выделить все]
(defun c:Insert_rename1 (/ blocks bl_name bl_obj doc noex ins ins_obj new_name new_block objects ins_get)
  (princ
    (if (and (setq ins (ru-ssentget-by-type "Выбери вставку блока" '("INSERT") 0))
             (setq ins_obj (vlax-ename->vla-object ins)
                   bl_name (vla-get-name ins_obj)
                   doc     (vla-get-Document ins_obj)
                   blocks  (vla-get-Blocks doc)
                   bl_obj  (vla-Item blocks bl_name)
                   noex    t
             )
             (while (and (not new_name) noex)
               (if (and (setq new_name (vl-catch-all-apply
                                         (function getstring)
                                         '("\nВведи новое имя (без пробелов) <Выход>: ")
                                       )
                        )
                        (/= new_name "")
                        (not (vl-catch-all-error-p new_name))
                   )
                 (if (vl-catch-all-error-p
                       (vl-catch-all-apply (function vla-item) (list blocks new_name))
                     )
                   t
                   (progn (setq new_name nil) (princ "\nТакой блок уже есть. Не годится!"))
                 )
                 (setq noex nil)
               )
             )
             (setq new_block (vla-add blocks (vla-get-Origin bl_obj) new_name))
             (vlax-for i bl_obj (setq objects (cons i objects)))
             (setq objects (vlax-make-variant
                             (vlax-safearray-fill
                               (vlax-make-safearray vlax-vbObject (cons 0 (1- (length objects))))
                               (reverse objects)
                             )
                           )
             )
             (vla-CopyObjects doc objects new_block)
             (setq ins_get (entget ins))
             (entmod (subst (cons 2 new_name) (assoc 2 ins_get) ins_get))
        )
      "\nГотово! Всё прошло хорошо."
      "\nНеудача! Чё-то пошло не так."
    )
  )
  (princ)
)

(defun ru-ssentget-by-type (msg types bits / sel cmd_lst)
;;;
;;; Параметры:
;;; msg - краткое приглашение для выбора, допускается NIL
;;; bits - целое от 0 до 15, битовый переключатель, значения битов:
;;;    1 - разрешение выбора на заблокированном слое
;;;    2 - разрешение многократного выбора
;;;    4 - разрешение выбора рамкой / секрамкой
;;;    8 - возвращать набор
;;; types - список имен допустимых типов примитивов, допускается NIL
;;;
;;; Пример:
;;; (ru-ssentget-by-type "Выбери отрезок или полилинию" '("LINE" "LWPOLYLINE") 0)
;;;
;;; Возвращает имя _первого_ примитива из попавших в набор, при удачном выборе
;;; или NIL при отказе с помощью Enter или прерывании по Esc, в последнем случае,
;;; одновременно выводит сообщение о прерывании в командную строку.
;;;
;;; При наличииии любого из битов: 2, 4 или 8 и при успешном выборе, возвращает
;;; не имя примитива, а набор.
;;;
  (setq msg     (strcat "\n"
                        (if msg
                          (strcat msg " ")
                          ""
                        )
                        (if (= (strcase (getvar "SYSCODEPAGE")) "ANSI_1251")
                          "<Выход>"
                          "<Exit>"
                        )
                )
        cmd_lst (if (= (logand bits 2) 0)
                  ":S"
                  ""
                )
        cmd_lst (if (= (logand bits 4) 0)
                  (strcat cmd_lst ":E")
                  cmd_lst
                )
        cmd_lst (if (= (logand bits 1) 0)
                  (strcat cmd_lst ":L")
                  cmd_lst
                )
        cmd_lst (if (/= cmd_lst "")
                  (list (strcat "_" cmd_lst))
                )
        types   (mapcar (function (lambda (x) (cons 0 x))) types)
  )
  (if (and types (> (length types) 1))
    (setq types (append (cons '(-4 . "<OR") types) '((-4 . "OR>"))))
  )
  (if types
    (setq cmd_lst (append cmd_lst (list types)))
  )
  (setvar "ERRNO" 0)
  (while (and (/= (getvar "ERRNO") 52) (not sel))
    (princ msg)
    (setvar "nomutt" 1)
    (vl-catch-all-error-p (setq sel (vl-catch-all-apply 'ssget cmd_lst)))
    (setvar "nomutt" 0)
    (if (and (not sel) (= (logand bits 2) 2))
      (setq sel t)
    )
  )
  (cond ((not sel) nil)
        ((= (type sel) 'pickset)
         (if (= (logand bits 14) 0)
           (ssname sel 0)
           sel
         )
        )
        ((= (type sel) 'vl-catch-all-apply-error) (princ (vl-catch-all-error-message sel)) nil)
        (t nil)
  )
)

Вариант Эдуарда:

Код:
[Выделить все]
(defun C:Insert_rename2
       (/ block_adoc ins new_name_block old_block obj sf_obj)
  (setq	block_adoc
	 (vla-get-blocks
	   (vla-get-ActiveDocument (vlax-get-acad-object))
	 ) ;_  end of_vla-get-blocks
  ) ;_  end of_setq
  (if
    (and
      (setq ins (car (entsel "\n Select insert for rename:")))
      (= (cdr (assoc 0 (entget ins))) "INSERT")
      (setq new_name_block (getstring "\nNew block name:"))
      (snvalid new_name_block)
      (not (tblsearch "block" new_name_block))
    ) ;_  end of_and
     (progn
       (setq
	 old_block (vla-item block_adoc (cdr (assoc 2 (entget ins))))
       ) ;_  end of_setq
       (vlax-for item old_block
	 (setq obj (cons item obj))
       ) ;_  end of_vlax-for
       (setq sf_obj (vlax-make-safearray
		      vlax-vbobject
		      (cons 0 (1- (length obj)))
		    ) ;_  end of_vlax-make-safearray
       ) ;_  end of_setq
       (vlax-safearray-fill sf_obj obj)
       (setq new_block
	      (vla-add block_adoc
		       (vlax-3d-point '(0 0 0))
		       new_name_block
	      ) ;_  end of_vla-add
       ) ;_  end of_setq
       (vla-CopyObjects
	 (vla-get-ActiveDocument (vlax-get-acad-object))
	 sf_obj
	 new_block
       ) ;_  end of_vla-CopyObjects
       (vla-put-name (vlax-ename->vla-object ins) new_name_block)
     ) ;_  end of_progn
  ) ;_  end of_if
) ;_  end of_defun
Просмотров: 15993
 
Непрочитано 28.05.2010, 13:20
#2
Piton

Инженер строитель
 
Регистрация: 24.02.2005
Москва
Сообщений: 396


К сожалению если использовать эти программы для динамических блоков то динамичность пропадает.
Piton вне форума  
 
Непрочитано 28.05.2010, 13:46
1 | #3
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


Без особых проверок
Код:
[Выделить все]
(vl-load-com)

(defun c:rename-insert (/ adoc name ent err)

  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  (if (and (= (type (setq ent (vl-catch-all-apply
                                (function
                                  (lambda ()
                                    (vlax-ename->vla-object (car (entsel "\nВыберите блок <Отмена> : ")))
                                    ) ;_ end of lambda
                                  ) ;_ end of function
                                ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'vla-object
              ) ;_ end of =
           (= (vla-get-objectname ent) "AcDbBlockReference")
           (= (type (setq name (vl-catch-all-apply
                                 (function
                                   (lambda ()
                                     (getstring t "\nВведите новое имя <Отмена> : ")
                                     ) ;_ end of lambda
                                   ) ;_ end of function
                                 ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'str
              ) ;_ end of =
           ) ;_ end of and
    (if (vl-catch-all-error-p
          (setq err
                 (vl-catch-all-apply
                   (function
                     (lambda ()
                       (vla-put-name (vla-item (vla-get-blocks adoc)
                                               (cond
                                                 ((vlax-property-available-p ent 'effectivename)
                                                  (vla-get-effectivename ent)
                                                  )
                                                 (t (vla-get-name ent))
                                                 ) ;_ end of cond
                                               ) ;_ end of vla-item
                                     name
                                     ) ;_ end of vla-put-name
                       ) ;_ end of lambda
                     ) ;_ end of function
                   ) ;_ end of vl-catch-all-apply
                ) ;_ end of setq
          ) ;_ end of VL-CATCH-ALL-ERROR-P
      (princ (strcat "\n** Ошибка ** : " (vl-catch-all-error-message err)))
      ) ;_ end of if
    ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun
Как будет обрабатывать, например, внешние ссылки,- не проверял.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 28.05.2010, 14:58
#4
VVA

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


И еще парочку ссылок на лиспы, котрые изменяют имена блоков:
Добавление индекса к именам выбранных блоков
U2B - конвертирует анонимные (*U) в обычные (Динамические так же конвертируются в обычные)
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 26.09.2011 в 10:27.
VVA вне форума  
 
Непрочитано 28.05.2010, 16:44
#5
Piton

Инженер строитель
 
Регистрация: 24.02.2005
Москва
Сообщений: 396


kpblc Переименовывает все вхождения блоков. А надо только одно
Piton вне форума  
 
Непрочитано 28.05.2010, 17:18
#6
VVA

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


Программа из этой ссылки: Redefining Block using Vlisp safearray
Сам не пробовал
Код:
[Выделить все]
;--------------------------------------------------------------------------------------
; CopyBlock - ROUTINE TO COPY A BLOCK AND RENAME IT
; Created by Vishal Gonsalves on 10-02-09
; My fist dialogue box, copied/modified Dimnote lsp to get the dialogue box action
; Gave up on annonymous block check error and forced blk_list to work if error - 26-02-09
; Success at last :) Thanks to Joe Burke and Tony Tanzillo for sharing their lisp.
 Dyanmic features work in new block - 17-02-10
;--------------------------------------------------------------------------------------
Вложения
Тип файла: rar CopyBlock.rar (1.9 Кб, 201 просмотров)
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 28.05.2010 в 22:18.
VVA вне форума  
 
Непрочитано 31.05.2010, 22:18
#7
superkot007


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


VVA, не работает. Сначала ругается на start в коде
Код:
[Выделить все]
(defun c:CB ()
(vl-load-com)(start)
Если удалить - запускается, появляется диалоговое окно, все выбираю, но безрезультатно:
Цитата:
no function definition: LAYER-SET
Во всяком случае, на 2011 так...
superkot007 вне форума  
 
Непрочитано 03.06.2010, 12:18
2 | #8
VVA

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


Благодаря подкинутым идеям из поста #6 написал другой CopyBlock.
Должен корректно обрабатывать (я надеюсь ) простые и динамические блоки.
Тестируйте
Вложения
Тип файла: lsp CopyBlock-VVA.lsp (11.8 Кб, 517 просмотров)
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 07.06.2010 в 17:13. Причина: Небольшие изменения
VVA вне форума  
 
Непрочитано 03.06.2010, 16:21
#9
Piton

Инженер строитель
 
Регистрация: 24.02.2005
Москва
Сообщений: 396


VVA

Спасибо за лисп. Все работает как надо.
Piton вне форума  
 
Непрочитано 03.06.2010, 22:16
#10
superkot007


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


Цитата:
Сообщение от VVA Посмотреть сообщение
Благодаря подкинутым идеям из поста #6 написал другой CopyBlock.
Должен корректно обрабатывать (я надеюсь ) простые и динамические блоки.
Тестируйте
А сброс динамического блока задумывался или это "фишка"? Но это уже мелочи, спасибо!
superkot007 вне форума  
 
Непрочитано 04.06.2010, 10:33
#11
VVA

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


Что значит сброс? Задумывалось устанавливать свойства блока такими же как у оригинала.
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 04.06.2010, 18:56
#12
superkot007


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


Цитата:
Сообщение от VVA Посмотреть сообщение
Что значит сброс? Задумывалось устанавливать свойства блока такими же как у оригинала.
Есть динамический блок (рамка с позицией оборудования и 4 варианта видимости выноски - справа, слева, снизу, сверху). По умолчанию блок создавался с "верхней" видимой выноской. Так вот - независимо от того, какое положение имеет выноска в блоке, новый блок всегда получается с "верхней" выноской (даже если у переименовываемого блока она слева, справа или снизу). Или я что не так понимаю?
superkot007 вне форума  
 
Непрочитано 04.06.2010, 19:35
#13
VVA

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


По идее должно восстанавливать видимость оригинального блока (слева или снизу). На моих динамических блоках так и происходит. Правда и меня их не много. Выложи блок, посмотрю в чем дело.
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 04.06.2010, 21:34
#14
superkot007


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


Цитата:
Сообщение от VVA Посмотреть сообщение
По идее должно восстанавливать видимость оригинального блока (слева или снизу). На моих динамических блоках так и происходит. Правда и меня их не много. Выложи блок, посмотрю в чем дело.
Ну примерно так... Два правых блока - "сброшены"
Вложения
Тип файла: dwg
DWG 2004
Позиция.dwg (38.2 Кб, 3681 просмотров)
superkot007 вне форума  
 
Непрочитано 07.06.2010, 17:14
#15
VVA

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


Внес изменения в #8
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 07.06.2010, 20:10
#16
superkot007


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


Теперь работает как надо, СПАСИБО!
superkot007 вне форума  
 
Непрочитано 20.10.2010, 20:11
#17
Хмурый


 
Регистрация: 29.10.2004
СПб
Сообщений: 16,327


в качестве справки: команда _flatten из комплекта Express Tools в режиме "не скрывать невидимые линии" изменяет имя блока на уникальное.
Хмурый вне форума  
 
Непрочитано 02.03.2012, 18:22
#18
VVA

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


Цитата:
Сообщение от VVA Посмотреть сообщение
Благодаря подкинутым идеям из поста #6 написал другой CopyBlock.
Должен корректно обрабатывать (я надеюсь ) простые и динамические блоки.
Тестируйте
Вложения
CopyBlock-VVA.lsp (11.8 Кб, 144 просмотров)
Дальнейшее развитие в теме LISP. Подготовка подосновы
команды
BGCB - копирует одно из вхождений блока в блок с новым именем
BGRB - переименовывает одно из вхождений блока в блок с новым именем
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 07.03.2012, 08:40
#19
Jonas

конструктор машиностроитель
 
Регистрация: 14.05.2007
Новосибирск
Сообщений: 893


Может я уже забыл как 2011, но в 2012 переименовывает блоки _rename.
Jonas вне форума  
 
Непрочитано 07.03.2012, 09:53
#20
VVA

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


Здесь ключевое слово "Переименование одного из вхождений блока"
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Готовые программы > LISP: Переименование одного из вхождений блока

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
LISP. Копирование, сортировка, переименование листов (layout) VVA Готовые программы 96 08.12.2023 14:11
LISP. Как определить вставку блока с xclip? Apelsinov LISP 4 18.02.2009 14:03
Переименование блока Torino Программирование 10 17.05.2005 13:11
Переименование блока вместе с аттрибутами? Mikhail AutoCAD 5 05.08.2004 20:59
возможно ли переименование внутреннего блока? Visla AutoCAD 3 04.03.2004 18:58