Redefine only blocks with a prefix name and synchronise attributes

[francine.zimmermannSRSWJ]

I have a lisp written by Lee Mac which works very well.

My only problem is that when I have hundred of blocks on my drawing the lisp takes a very long time to run.

Is it possible to redefine only the blocks starting with the block name TM.....?

example of block name : TM-1005, TM-0349, TM-1006........

Thank you for your help

[ronjonp · Accepted solution]

@francine.zimmermannSRSWJ 

(and
  (= :vlax-false (vla-get-isxref blk))
  (= :vlax-false (vla-get-islayout blk))
  (not (wcmatch (setq bln (vla-get-name blk)) "`**,*|*"))
  ;; Add this line
  (wcmatch bln "TM*")
)

[francine.zimmermannSRSWJ]

Is it possible to add more block starting name? for example "TM*" , "KG*" , "AM*" 

[ronjonp · Accepted solution]

Yes. Separate the patterns with commas like so:

(wcmatch bln "TM*,KG*,AM*")

[francine.zimmermannSRSWJ]

Thank you , it works well.

I have an other lisp to redefine multiple block from a list of different directories.

(setq G:LISTDIR (list "C:\\000_Block\\Block"
"C:\\000_Block\\Profile"
))

Is it also possible, on that lisp, to redefine only blocks with a defined prefix name ?

I don't know where or how to integrate the command line solution (wvmatch bln "TM*, KG*")

[komondormrex]

check this mod. did not check thou.

(defun C:REDEF-P( / BLK BLT LAUF N WAH )
	(setq G:LISTDIR (list "C:\\000_Block\\Block" 
			      "C:\\000_Block\\Profile" 
			)
	)
	(if G:LISTDIR
		(progn
			(princ "\n\nDirectory list\n")
 			(foreach N G:LISTDIR 
				(princ (strcat "\n" N))
			)
			(princ "\n***********************\n")
	  		(setvar "cmdecho" 0)
			(setvar "regenmode" 0) 
	  		(setq BLK nil
	        		LAUF 0
	  		)
	  		(while (setq BLT (tblnext "BLOCK" (= LAUF 0)))
	         	        (setq LAUF 1)
	         	        (setq BLK (cdr (assoc 2 BLT)) )
			        (setq L:FLAGINSERT nil)
				(if (and (/= "*" (substr BLK 1 1))
					 (wcmatch BLK "TM*,KG*")
				    )
					(progn
	  					(foreach N G:LISTDIR 
								(progn
	 								(setq L:FILE (strcat N "\\" BLK ".DWG"))
									(if (and (findfile L:FILE) (not L:FLAGINSERT))
										(progn
				 							(command "._INSERT" (strcat BLK "=" L:FILE) "0.0,0.0,0.0" "" "" "")
											(command "._erase" "l" "")
											(setq L:FLAGINSERT T)
											(princ (strcat "\n" L:FILE " reinserted"))
				 						)
;;;				 						(progn
						;					(princ (strcat L:FILE " not found\n"))
;;;				 						)
									)
								)
	  					)
						(if (not L:FLAGINSERT )
							(princ (strcat "\nBlock " BLK " unchanged"))
						)
					)
				)
			)
	  		(setvar "cmdecho" 1)
			(setvar "regenmode" 1) 
			(princ "\n")
 			(command "regen")
		)
	)
 	(princ)
)

[francine.zimmermannSRSWJ]

I test it and I get that answer: 

[francine.zimmermannSRSWJ]

I found the error , you have write wvmatch and it is wcmatch

Now the lisp is working

many thank

[francine.zimmermannSRSWJ]

The lisp work well and redefine only those with given prefix name.

But is it possible to avoid all others unnecessary blocks on the command line ? For example : Duplicate definition of block ISO13918_M6x12 ignore.

All blocks from the drawing are listed on the command line and it takes too much time, especially as I'm limiting the type of blocks to be reinserted. 

Is it possible to notify only what we're looking for?

[komondormrex · Accepted solution]

hth

(defun c:redefine_block (/ where_dirs block_mask block_name redefine_block_list dir_blocks)
	(setq where_dirs (list "C:\\000_Block\\Block" 
			      		   "C:\\000_Block\\Profile"
			   	   	 )
		  block_mask "TM*,KG*"
	)
	(vlax-map-collection (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
						'(lambda (block) (if (and (zerop (vlax-get block 'isxref))
												  (zerop (vlax-get block 'islayout))
												  (wcmatch (setq block_name (vla-get-name block)) block_mask)
											 )
											 (setq redefine_block_list (cons (strcase block_name) redefine_block_list))
										 )
						 )
	)
	(if (setq dir_blocks 
				(vl-remove-if-not 'cadr 
								   (mapcar '(lambda (dir) (cons dir 
								   								(list (vl-remove-if-not '(lambda (file_name) (member (strcase (vl-filename-base file_name))
																													 redefine_block_list
																							 				 )
																		  				 )
																		  				 (vl-directory-files dir "*.dwg" 1)
																	  )
												  				)
														  )
						  					)
									  		where_dirs
							 		)  
				)
		 )     
		 (progn
		 	(foreach dir dir_blocks
		 		(foreach file_name (cadr dir)
		 			(vla-erase
		 				(vla-insertblock (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
		 								 (vlax-3d-point 0 0 0)
		 								 (strcat (car dir) "\\" file_name) 
		 								 1 1 1 0
		 				)
		 			)
					(princ (strcat "Block \"" (vl-filename-base file_name) "\" redefined\n")) 
		 		)
		 	)
			(vla-regen (vla-get-activedocument (vlax-get-acad-object)) acactiveviewport) 
		)
	)
	(princ)
)

[francine.zimmermannSRSWJ]

 I tested your lisp, the list of block is working well but it don't redefine the modify blocks

[komondormrex]

what do you mean exactly?

[komondormrex]

ah, i see now. check the updated code above.

[francine.zimmermannSRSWJ]

Now it works perfectly 😊