[Torino]

Не уверен, что мой вопрос должен быть в этом разделе (может его стоит запостить в раздел "Программирование"):

Есть блок.
Я его копирую, чтобы использовать в другой части чертежа.
Один из экземпляров блока надо изменить.
Я его изменяю.
Но при этом изменяется и второй экземпляр.

Что я делаю, чтобы этого избежать:
один из экземпляров я взрываю,
а затем создаю новый блок с другим именем
и изменяю уже его.

Существует ли возможность быстрого переименования блока.
Какие нибудь встроенные средства Акада или лисп или макрос?

Пробую такой макрос

Код:

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

_.select;\_.explode;l;;_.-block;\\l;;
Не работает.
(использую в нем Last т.к. Previous не работает)

[Grinzaid]

А FORMAT/RENAME не пробовали? Или я не понял вопроса?

[{Smirnoff}]

_rename и никаких проблем.

[Pilot]

Насколько я понял, нужно:
1. Сделать копию референта блока.
2. Переименовать именно копию.
3. Изменить копию.

Но это невозможно, т.к. имя имеет не референт блока, а его описание. А все референты - суть множественные вставки одного описания.

[Хмурый]

_rename- работает.

Только имена изменяются у всех вхождений блока, вставленных до применения команды _rename. Эти переобозванные блоки можно редактировать, что не оказывает влияния на исходный блок.

[Alaspher]

Судя по всему, ты хочешь что-то в таком духе:

Код:

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

(defun demo (/ 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)
  )
)

Запуск:

Код:

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

(demo)

Код демонстрационый, могут быть накладки.

[Apelsinov]

>Alaspher
АЧЮМЕТЬ!!!
не, ну так не честно, как можно такие чтуки так быстро писать... :roll:

Когда я работал в одной конторе, к нам на практику пришла девочка из института, проработала месяца три, потом босс вызвал ее до разговору, и спрашивает, типа будешь у нас после института работать?
Она ему и говорит: "Да Вы что! Я лучше буду икебаны плести..."

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

[Alaspher]

> Apelsinov
Функция ru-ssentget-by-type - библиотечная, а остальное..., ну я прикинул, что написать демокод будет быстрее, чем объяснять то, как это можно сделать.

[Torino]

Rename - это конечно хорошо, но долго и интуитивно не понятно.

А вот лисп - самое то.
Alaspher спасибо - помогло!

Еще до кучи вариант Эдуарда:

Код:

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

(defun C:Insert_rename
       (/ 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

[Alaspher]

> Torino
На здоровье!

Вариант Эдуарда, практически - аналог. Различия, в основном, в проверках.

[ZZZ]

И ещё в общую кучку

Код:

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

;;;Переименовать блок
(defun c:z-block-rename  (/ select block block_name_old block_name_new object)
  ;(z-undo-begin-group 0)
  (setq select (entsel "\nSelect block:"))
  (while (or
	   (not select)
	   (/= (item 0 (entget (car select))) "INSERT"))
    (setq select (entsel "\nSelect block:")))
  (setq block (car select))
  (setq block_name_old (item 2 (entget block)));*
  (setq block_name_new (z-dialog-text-edit block_name_old));*
  (if (and block_name_new (/= block_name_old block_name_new))
    (progn
      (entmake)
      (entmake (subst (cons 2 block_name_new)
		      (cons 2 block_name_old)
		      (entget (tblobjname "block" block_name_old))))
      (setq object (tblobjname "block" block_name_old))
      (while (and
	       (setq object (entnext object))
	       (/= (item 0 (entget object)) "ENDBLK"));*
	(entmake (entget object))
	)
      (entmake '((0 . "ENDBLK")))
      (entmake)
      (entmod (subst (cons 2 block_name_new) (cons 2 block_name_old) (entget block)))
      (entupd block)
      )
    ) ;if
  ;(z-undo-end-group 1)
  (princ)
  );z-block-rename

где
item = (cdr (assoc a b))
(z-dialog-text-edit block_name_old) - у меня вызывается диалоговое окно, которое возвращает текстовую строку с новым названием блока, можно заменить на (getstring "\nNew block name:"))

Только в проге есть недостаток при использовании в 2006 (динамические блоки подглючивают).