[Кочетков Андрей]

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

Вариант 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

[G.A.W.]

Можно немного понекрофилить!

А можно сделать так, чтобы переименовывать выбранные блоки, а не один? Т.е. есть куча блоков, например 100 штук, с названием "1", вот из них я например выбираю 30 штук, каких мне нужно, и переименовываю в "2"?

[sdv79]

При копировании модулем "CopyBlock-VVA" заливка "наползает" на поллинию, подскажите как избавиться от данного эффекта?
решение по http://forum.dwg.ru/showthread.php?t=42123 вызывает фатальную ошибку
Проблема с заливкой остается при использовании http://forum.dwg.ru/showthread.php?p=885344#post885344 bgtools2.31 командами
BGCB - копирует одно из вхождений блока в блок с новым именем
BGRB - переименовывает одно из вхождений блока в блок с новым именем

Наилучший результат выдает C:Insert_rename2 из шапки, но прячет текст за заливку.

[VVA]

Попробуй еще это Copy or Rename Block Reference

[sdv79]

Спасибо. Не помогло.