Selected Block Replace - Attributes Coordinates

[ChaitanyaHeb]

Hello Everyone,
I hope everyone are doing well.

I have lisp file whose functionality is to replace selected blocks with new block and transfer the old blocks attribute values to the new block while retaining some attributes value in the new block (which is mentioned in code). The issue I'm facing is, though old blocks gets replaced, attribute values are getting transferred to the new block but the attribute position (more precisely the attributes co-ordinates) of the new block is not same as the old block. I have to manually place again the attributes where it was earlier or at-least try to match the old position.

Can someone take look at this code and point out where I am missing..

Thanks in Advance...😊

[pbejse]

You mind posting a drawing sample so we can have better understanding of the position issue?

[ec-cad]

Try removing (1) scaleFactor in this line:

(command "_.insert" newBlkName insertPt scaleFactor scaleFactor scaleFactor 0)

So it follows the pattern: (command "_.insert" Blockname InsertionPoint ScaleFactor ScaleFactor Rotation)

And in addition Add (setvar 'Attreq 0), just before the (command "_.insert" ... line.

Then, at end of program, add (setvar 'Attreq 1), for normal operations.

ECCAD

[paullimapa]

Are the Attributes in the new block actually positioned in the same location as those being replaced found in the old block? If not, then you'll have this kind of displacement discrepancy. Perhaps share your old & new blocks to the community here to review?

[ec-cad]

Paulli,

Yes, original block and replacement block will need 'same' attribute Tagname and Justification

in order not to 'shift' anything around. I thought about that, but didn't post..since OP's code

seems to check / set those values.

ECCAD

[paullimapa]

waiting for OP to share both blocks then we can confirm...

[ChaitanyaHeb]

Hi Everyone,

Sorry for delayed response. I got stuck in one project due to which I did not get sufficient time to share the file. Please find the attached DWG file and small clip. Clip will help you to understand my issue.

I apologise again..

Regards,
Chaitanya Heblikar

[ВeekeeCZ]

The RIblock routine should do the job, but fails for some reason.

https://www.cadforum.cz/cz/download.asp?file=riblock&sort=

1) 

Select one of the blocks to be replaced

fails with Error : bad argument type: stringp nil

2)

Select one of the blocks to be replaced or [Typed/Selection]: S

Select block references to replace

does not fail with error.. but the outcome is a bit surprising... it redefines _Oblique block???

Seems challenging enough for @vladimir_michl 

[vladimir_michl]

It seems to work on my side (RiBlock V1.4) - Selecting the two indicated blocks and then Picking the top instance of the replacement block. Only the attributes seem to be displaced but it might be a result of the visibility states in the dynamic block.

Vladimir Michl, www.arkance.world  -  www.cadforum.cz

[ВeekeeCZ]

Thanks for the reply. As I said, not for me. 

Hopefully, the OP will have better luck than me.

[ChaitanyaHeb]

I do not have permission to download from 3rd party website in my office laptop. So can you guys please look into the code I gave and point out the possible solution to my issue...

[paullimapa]

The problem is pretty clear. Your original Ceiling Mounted speakers have different attribute positions compared to the replacement Wall Mounted speakers attribute positions. 

I purposely filled out both blocks attributes using their attribute TAG names so they can be seen on the screen exactly where they're positioned now.

WG attribute in the Wall Mounted block is positioned a bit higher than the WG attribute in the Ceiling Mounted version

WATT & NOTE attributes are in the same position in both so these 2 attribute values will show up fine after replacement.

SPEAKTAG attribute in the Wall Mounted block is positioned in the lower left corner whereas it's positioned in the upper left corner in the Ceiling Mounted version

WP attribute in the Wall Mounted block is positioned in the lower right corner whereas it's positioned in the upper right corner in the Ceiling Mounted version

NACTAG attribute in the Wall Mounted block is positioned in the lower left corner about the same position as SPEAKTAG whereas it's positioned in the upper right corner in the Ceiling Mounted version

So the way to fix this is to Blockedit & then AttSync the Wall Mounted version so that the attribute positions match with the Ceiling Mounted version

[komondormrex]

hey there,

check this yet another code following

;*************************************************************************************************************************************************************************************

;	replace_blocks custom command.
;	replaces target blocks (to be replaced) with source (replacing) block.
;	keeps target block's properties, target block's attributes with their properties, target block's dynamic properties if applicable.

;	komondormrex, dec 2024

;*************************************************************************************************************************************************************************************

(defun gather_att_dyn_other (insert / att_dyn_oth_list)
	(setq att_dyn_oth_list (vl-remove nil
						   			 (append
						   					 (list (list "Xeffectivescalefactor" nil (vla-get-xeffectivescalefactor insert))				;	scale, rotation
						   						   (list "Yeffectivescalefactor" nil (vla-get-yeffectivescalefactor insert))
						   					 	   (list "Zeffectivescalefactor" nil (vla-get-zeffectivescalefactor insert))
						   					 	   (list "Rotation" nil (vla-get-rotation insert))
						   					 )
						   					 (if (minusp (vlax-get insert 'hasattributes))
						   						 (mapcar '(lambda (attribute) (list (vla-get-tagstring attribute)
												 									0 														;	attribute
																					attribute
																				    (vla-get-textstring attribute))
														  )
						   								  (vlax-invoke insert 'getattributes)
						   						 )
						   					 )
						   					 (if (minusp (vlax-get insert 'isdynamicblock))
						   						 (mapcar '(lambda (dyn_property) (if (/= "Origin" (vla-get-propertyname dyn_property))
						   															 (list (strcase (vla-get-propertyname dyn_property))
																					 	   -1                                               ;	dyn property
																						   dyn_property
																						  (vlax-variant-value (vla-get-value dyn_property))
																					 )
						   														 )
						   								  )
						   								  (vlax-invoke insert 'getdynamicblockproperties)
						   						 )
						   					 )
						   			 )
							)
	)
)

;*************************************************************************************************************************************************************************************

(defun list_locked_layers (/ ll_list)
	(vlax-map-collection (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
		'(lambda (layer) (if (minusp (vlax-get layer 'lock)) (setq ll_list (append ll_list (list layer)))))
	)
	ll_list
)

;*************************************************************************************************************************************************************************************

(defun unlock_layer_list (ll_list)
	(foreach layer ll_list
		(vlax-put layer 'lock 0)
	)
)

;*************************************************************************************************************************************************************************************

(defun lock_layer_list (ll_list)
	(foreach layer ll_list
		(vlax-put layer 'lock -1)
	)
)

;*************************************************************************************************************************************************************************************

(defun c:replace_blocks (/ block_rg block_rg_name blocks_tbr_sset property_rd replaced names_tbr_list ll_list princ_ block_rg_props block_rd_props)
	(if (and (null (while (and (if (setq block_rg_data (vl-catch-all-apply 'entsel (list "\nPick replacing block: "))) t t)
						  	   (cond
						  			  ((null block_rg_data) t)
						  			  ((vl-catch-all-error-p block_rg_data) nil)
						  			  ((/= "AcDbBlockReference" (vla-get-objectname (setq block_rg (vlax-ename->vla-object (car block_rg_data))))) t)
						  			  (t nil)
						  	   )
						  )
			   		)
			 )
			 block_rg
		)
		(progn
		  	   (setq block_rg_name (vla-get-effectivename block_rg)
			   		 princ_ (princ "\nPick blocks to be replaced...")
		  			 blocks_tbr_sset (ssget '((0 . "insert")))                          ;	blocks to be replaced
					 replaced 0
			   )
			   (if blocks_tbr_sset
					(progn
					   (setq ll_list (list_locked_layers))
					   (unlock_layer_list ll_list)
					   (foreach insert (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex blocks_tbr_sset))))
							(setq block_rg (vla-insertblock (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
															(vla-get-insertionpoint insert)
															block_rg_name 1 1 1 0
										   )
								  block_rg_props (gather_att_dyn_other block_rg)		;	replacing
								  block_rd_props (gather_att_dyn_other insert)			;	replaced
							)
							(foreach property '(entitytransparency layer linetype linetypescale lineweight material plotstylename truecolor)
		   						(vl-catch-all-apply (read (strcat "vla-put-" (vl-princ-to-string property)))
		   											(list block_rg (eval (list (read (strcat "vla-get-" (vl-princ-to-string property))) insert)))
		   						)
		   					)
							(foreach property block_rg_props
								(cond
									((and (setq property_rd (assoc (car property) block_rd_props)) (null (cadr property)))
										  (vlax-put block_rg (read (car property)) (last property_rd))
									)
									((and property_rd (zerop (cadr property)))
										  (vla-put-textstring (caddr property) (last property_rd))

										  (foreach a_property '(alignment backward entitytransparency fieldlength height linetype linetypescale lineweight
													  			material mtextattribute mtextattributecontent mtextboundarywidth mtextdrawingdirection obliqueangle plotstylename
																rotation scalefactor stylename textgenerationflag thickness truecolor upsidedown visible
															   )
		   									(vl-catch-all-apply (read (strcat "vla-put-" (vl-princ-to-string a_property)))
		   											  			(list (caddr property) (eval (list (read (strcat "vla-get-" (vl-princ-to-string a_property))) (caddr property_rd))))
		   									)
		   								  )
									)
									((and property_rd (minusp (cadr property)))
										  (vla-put-value (caddr property) (last property_rd))
									)
									(t)
								)
							)
							(vla-delete insert)
							(princ (strcat "\rBlocks replaced: " (itoa (setq replaced (1+ replaced)))))
					   )
    				   (if (not (zerop replaced))
						   	(progn
    					   		(terpri)
								(vla-regen (vla-get-activedocument (vlax-get-acad-object)) acactiveviewport)
							)
					   )
					   (lock_layer_list ll_list)
					)
			)
		)
	)
	(princ)
)

;*************************************************************************************************************************************************************************************

[pbejse]

(defun TransferAttributes (sourceAttributes targetAttributes)
    (foreach sAtt sourceAttributes
      (setq sTag (strcase (vla-get-TagString sAtt)))
      (setq sValue (vla-get-TextString sAtt))
      (setq sAlignment (vla-get-Alignment sAtt))  ; Get the alignment of the source attribute
      (setq sPosition (vlax-get sAtt 'InsertionPoint)) ; Get position of the source attribute
      (setq sApoint (vlax-get sAtt 'TextAlignmentPoint))
      
      (if (not (member sTag retainTags))
        (foreach tAtt targetAttributes
          (if (eq sTag (strcase (vla-get-TagString tAtt)))
            (progn
              (vla-put-TextString tAtt sValue)
              (vla-put-Alignment tAtt sAlignment)  ; Set alignment
	      (if (zerop sAlignment)
              		(vlax-put tAtt 'InsertionPoint sPosition) ; Set position
			(vlax-put tAtt 'TextAlignmentPoint sApoint))
              (vla-put-Rotation tAtt 0) ; Explicitly set attribute rotation to 0
            )
          )
        )
      )
    )
    (princ)
  )

Added these two lines

...
      (setq sApoint (vlax-get sAtt 'TextAlignmentPoint))
...
(if (zerop sAlignment)
              		(vlax-put tAtt 'InsertionPoint sPosition) ; Set position
			(vlax-put tAtt 'TextAlignmentPoint sApoint))
...

HTH