[Sleekka]

Уважаемые программисты, помогите пожалуйста.
Нужно вставить новые блоки на место старых, с теми же парамметрами scale X, и т. д. и удалить старые вхождения.

[Piton]

Попробуй

Код:

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

blockreplace

из экспрессов

[Кулик Алексей aka kpblc]

Гы... Я уж накатал прожку. Правда, без проверок. Если интересно:

Код:

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

;;;Недостающие функции можно взять здесь:
;;;http://www.arcada.com.ua/forum/viewtopic.php?t=504&postdays=0&postorder=asc&start=15
(defun c:blkreplace (/			 adoc
		     old_blk		 new_blk
		     vla_blk		 selset
		     *error*		 _kpblc-layer-status-save
		     _kpblc-layer-status-restore
		     )
  (defun *error* (msg)
    (_kpblc-layer-status-restore)
    (vla-endundomark *kpblc-activedoc*)
    (princ msg)
    (princ)
    ) ;_ end of defun

  (setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark *kpblc-activedoc*)
  (if
    (and (setq old_blk
		(car (entsel "\nУкажите блок, который будет меняться <Выход> : ")
		     ) ;_ end of car
	       ) ;_ end of setq
	 (= (cdr (assoc 0 (entget old_blk))) "INSERT")
	 (setq
	   new_blk (car (entsel "\nУкажите блок, который вставляем <Выход> : "))
	   ) ;_ end of setq
	 (= (cdr (assoc 0 (entget new_blk))) "INSERT")
	 (setq new_blk (cdr (assoc 2 (entget new_blk))))
	 ) ;_ end of and
     (foreach item
	      (mapcar
		'vlax-ename->vla-object
		(vl-remove-if
		  'listp
		  (mapcar
		    'cadr
		    (ssnamex
		      (ssget "_X"
			     (list '(0 . "INSERT") (assoc 2 (entget old_blk)))
			     ) ;_ end of ssget
		      ) ;_ end of ssnamex
		    ) ;_ end of mapcar
		  ) ;_ end of vl-remove-if
		) ;_ end of mapcar
       (setq vla_blk (vla-insertblock
		       (vla-objectidtoobject
			 *kpblc-activedoc*
			 (vla-get-ownerid item)
			 ) ;_ end of vla-ObjectIDToObject
		       (vla-get-insertionpoint item)
		       new_blk
		       (vla-get-xscalefactor item)
		       (vla-get-yscalefactor item)
		       (vla-get-zscalefactor item)
		       (vla-get-rotation item)
		       ) ;_ end of vla-InsertBlock
	     ) ;_ end of setq
       (foreach	prop '("layer" "linetype" "lineweight" "color")
	 (vl-catch-all-apply
	   'vlax-put-property
	   (list vla_blk (vlax-get-property item prop))
	   ) ;_ end of VL-CATCH-ALL-APPLY
	 ) ;_ end of foreach
       ) ;_ end of foreach
     (princ "\nОшибка указания\n")
     ) ;_ end of if
  (vla-endundomark *kpblc-activedoc*)
  (princ)
  ) ;_ end of defun