Replace block lisp

[Anonymous]

hello 

i have lisp to replace selected blocks with new block ... when i replace blocks ... the new blocks don't inserted into the same place of old blocks ... i want the new blocks location at the same location of old blocks ... can anyone help me ..

(defun c:BLREP (/ ACTDOC COPOBJ ERRCOUNT EXTLST EXTSET FROMCEN LAYCOL MAXPT CURLAY MINPT OBJLAY OKCOUNT OLAYST SCLAY TOCEN TOOBJ VLAOBJ *ERROR* )
(vl-load-com)
(defun *ERROR* (msg)
(if olaySt
(vla-put-Lock objLay olaySt)
); end if
(vla-EndUndoMark actDoc)
(princ)
); end of *ERROR*
(defun GetBoundingCenter (vlaObj / blPt trPt cnPt)
(vla-GetBoundingBox vlaObj 'minPt 'maxPt)
(setq blPt (vlax-safearray->list minPt)
trPt (vlax-safearray->list maxPt)
cnPt (vlax-3D-point (list (+ (car blPt) (/ (- (car trPt) (car blPt)) 2)) (+ (cadr blPt) (/ (- (cadr trPt) (cadr blPt)) 2)) 0.0
); end list
); end vlax-3D-point
); end setq
); end of GetBoundingCenter
(if (not (setq extSet (ssget "_I")))
(progn
(princ "\n<<< Select objects to replace >>> ")
(setq extSet (ssget))
); end progn
); end if
(if (not extSet)
(princ "\n Replace objects isn't selected ")
); end if
(if (and extSet (setq toObj (entsel "\nSelect new object -> ")) ); and and
(progn
(setq actDoc (vla-get-ActiveDocument (vlax-get-Acad-object) )
layCol (vla-get-Layers actDoc)
extLst (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex extSet)) ) )
vlaObj (vlax-ename->vla-object (car toObj))
objLay (vla-Item layCol (vla-get-Layer vlaObj) )
olaySt (vla-get-Lock objLay)
fromCen (GetBoundingCenter vlaObj)
errCount 0
okCount 0
); end setq
(vla-StartUndoMark actDoc)
(foreach obj extLst
(setq toCen (GetBoundingCenter obj)
scLay (vla-Item layCol (vla-get-Layer obj) )
);end setq
(if (/= :vlax-true (vla-get-Lock scLay))
(progn
(setq curLay (vla-get-Layer obj))
(vla-put-Lock objLay :vlax-false)
(setq copObj (vla-copy vlaObj))
(vlax-put-property copObj "Rotation" (vlax-get Obj "Rotation" ))
(vla-Move copObj fromCen toCen)
(vla-put-Layer copObj curLay)
(vla-put-Lock objLay olaySt)
(vla-Delete obj)
(setq okCount (1+ okCount))
); end progn
(setq errCount (1+ errCount))
); end if
); end foreach
(princ (strcat "\n" (itoa okCount) " were changed. "
(if (/= 0 errCount) (strcat (itoa errCount) " were on locked layer! ") "" ); end if
); end strcat
); end princ
(vla-EndUndoMark actDoc)
); end progn
(princ "\n New object isn't selected ")
)
) 

[Moshe-A]

@Anonymous  hi,

changes in red.

enjoy

moshe

(defun c:BLREP (/ ACTDOC COPOBJ ERRCOUNT EXTLST EXTSET FROMCEN LAYCOL MAXPT CURLAY MINPT OBJLAY OKCOUNT OLAYST SCLAY TOCEN TOOBJ VLAOBJ *ERROR* )
 (vl-load-com)
  
 (defun *ERROR* (msg)
  (if olaySt
   (vla-put-Lock objLay olaySt)
  ); end if
   
  (vla-EndUndoMark actDoc)
  (princ)
 ); end of *ERROR*
  
 (defun GetBoundingCenter (vlaObj / blPt trPt cnPt)
  (vla-GetBoundingBox vlaObj 'minPt 'maxPt)
  (setq blPt (vlax-safearray->list minPt)
        trPt (vlax-safearray->list maxPt)
        cnPt (vlax-3D-point (list (+ (car blPt) (/ (- (car trPt) (car blPt)) 2)) (+ (cadr blPt) (/ (- (cadr trPt) (cadr blPt)) 2)) 0.0))
  ); end setq
 ); end of GetBoundingCenter
  
 (if (not (setq extSet (ssget "_I")))
  (progn
   (princ "\n<<< Select objects to replace >>> ")
   (setq extSet (ssget))
  ); end progn
 ); end if
  
 (if (not extSet)
  (princ "\n Replace objects isn't selected ")
 ); end if
  
 (if (and extSet (setq toObj (entsel "\nSelect new object -> ")) ); and and
  (progn
   (setq actDoc (vla-get-ActiveDocument (vlax-get-Acad-object) )
         layCol (vla-get-Layers actDoc)
         extLst (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex extSet))))
         vlaObj (vlax-ename->vla-object (car toObj))
         objLay (vla-Item layCol (vla-get-Layer vlaObj))
         olaySt (vla-get-Lock objLay)
         ; fromCen (GetBoundingCenter vlaObj)
	 fromCen (vla-get-insertionPoint vlaObj)
         errCount 0
         okCount 0
  ); end setq
   
  (vla-StartUndoMark actDoc)
  (foreach obj extLst
   ; (setq toCen (GetBoundingCenter obj)
   (setq toCen (vla-get-insertionPoint obj)
         scLay (vla-Item layCol (vla-get-Layer obj) )
   );end setq
  
   (if (/= :vlax-true (vla-get-Lock scLay))
    (progn
     (setq curLay (vla-get-Layer obj))
     (vla-put-Lock objLay :vlax-false)
     (setq copObj (vla-copy vlaObj))
     (vlax-put-property copObj "Rotation" (vlax-get Obj "Rotation" ))
     (vla-Move copObj fromCen toCen)
     (vla-put-Layer copObj curLay)
     (vla-put-Lock objLay olaySt)
     (vla-Delete obj)
     (setq okCount (1+ okCount))
    ); end progn
    (setq errCount (1+ errCount))
   ); end if
  ); end foreach
   
   (princ (strcat "\n" (itoa okCount) " were changed. " (if (/= 0 errCount) (strcat (itoa errCount) " were on locked layer! ") "" )))
   (vla-EndUndoMark actDoc)
  ); end progn
  (princ "\n New object isn't selected ")
 ); if
)

[Anonymous]

thank you for replaying ... its working but when the old block insertion point (pick point) wasn't in the center of the block the new block will shifted according to pick point location !!! 

[Moshe-A]

@Anonymous 

there are some ways to replace a block:

one is by it's center of it's bounding box, your lisp was doing exactly that and you did not want that.

the second is by it's insertion point and it still doesn't do?!

sorry i do not know of a third way 

[Kent1Cooper]

---

@Anonymous wrote:

... when i replace blocks ... the new blocks don't inserted into the same place of old blocks ... i want the new blocks location at the same location of old blocks …

---

What is in  your Blocks?  I ask because this is based on the bounding boxes of the Blocks.  Some objects can "throw off" the bounding box, so that the center of the bounding box does not look like  the center of the drawn contents.  For instance, the width of the bounding box of Mtext is its defining box width, even if the characters in it fill only part of that width.  And Splines can have bounding boxes that extend beyond what you expect in some directions.  And non-zero rotations impact the bounding boxes of Block insertions [it's as if the Block included a rectangle drawn around its bounding box at zero rotation, and the bounding box of the rotated Block is that of the rotated rectangle that isn't really there].

Can you post a simple sample drawing file that illustrates the problem you're having, including typical Blocks, and showing before conditions, after conditions that are not what you want, and after conditions you do want?