Combine 2 or more blocks into a new block using Toolpalettes

Hans_Knol — Tue, 03 Jun 2025 17:57:45 GMT

Hi all,

We like to use the Toolpalettes for inserting blocks. In the original blocks ( from AutoCAD Plant3D P&ID) There must be added some Attributes like TagNumber, Manufacturer and TypeNumber, maby more. Is there someone that is able to create a lisp that can combine a drawing (see attachment) and a drawing that contains the attributes.

when it are 2 seperate blocks you are more flexeble for the future.

Re: Combine 2 or more blocks into a new block using Toolpalettes

Moshe-A — Thu, 05 Jun 2025 13:49:03 GMT

@Hans_Knol hi,

Where is the block with the attributes?

say you have a drawing with attributes - ok?!

how do you expect that it will fall exactly on the spot it should?

what i am trying to say is: you have to make so many preparations to make this macro to work it is more worth to directly combine it manually.

Moshe

Re: Combine 2 or more blocks into a new block using Toolpalettes

Hans_Knol — Thu, 05 Jun 2025 14:07:57 GMT

sorry, I forgot to add. but it can also be something in lisp that add some attributes.

Hans

Re: Combine 2 or more blocks into a new block using Toolpalettes

Moshe-A — Sat, 07 Jun 2025 11:07:47 GMT

@Hans_Knol hi,

Check this (block_merge) function.

Read file header carefully for instruction how to use it.

the lisp should be loaded from APPLOAD and the function may be called from any lisp program, menus and your tool palette 😀

enjoy

Moshe

; blkmrg.lsp ; by Moshe-A ; JUN 06 2025 ; Arguments: ; lst is a list of dotted pair as: '( (content . bname) (content . bname)...) ; where content is string a valid drawing name, can be full path ; bname is string a valid block name to insert/merge can also be full path ; supply nil for content if content drawing is not exist ; bname must exist (can not be nil) and be a valid block name ; lst must have more then 1 items (e.g 2 or more) ; the first bname is the host for successive items ; example: '( ("c:/library/content.dwg" . "DIN 7-23 - Gate valve - Open.dwg") ; ("c:/library/content.dwg" . "DIN 7-12 - Angle check valve.dwg") ; ("c:/library/content.dwg" . "tag.dwg") ...) ; Use only forward slash '/' not back slashs '\\' ; OR ; example: '( (nil . "DIN 7-23 - Gate valve - Open") ; (nil . "DIN 7-12 - Angle check valve") ; (nil . "tag") ...) ; Returns: ; if success? return the host (first) block name ready to be insert or nil if it fail to merge ; if bname is already in current drawing no merge work is done ; to make it work, make sure the block is not already exist. ; Note ; the function may also crash at insertcontent command if the block is not found. in this case check the content file or miss spelled block name. (defun block_merge (lst / _validate_data strip_file_name insert_block adoc blocks savAttdia savAttreq i pair bname content fname host-bname AcDbBlkTblRec) ; return t if lst is valid, nil if not (defun _validate_data () (vl-every (function (lambda (pair) (and (or (not (car pair)) (and (car pair) (eq (type (car pair)) 'STR) ) ) (cdr pair) (eq (type (cdr pair)) 'STR) ) ); lambda ); function lst ); vl-every ); _validate_data (defun strip_file_name (file flag1 / drive fname) (cond ((not flag1) (vl-filename-base file) ) ( t (setq drive (vl-filename-directory file)) (setq fname (vl-filename-base file)) (strcat drive fname) ) ); case ); strip_file_name ; insert block as nested (defun insert_block (flag AcDbBlkTblObj fname / AcDbBlkRef exploded^) (if flag (entdel (entlast)) ) (setq AcDbBlkRef (vla-insertBlock AcDbBlkTblObj (vlax-3d-point '(0.0 0.0 0.0)) (strip_file_name fname nil) 1.0 1.0 1.0 0.0)) (setq exploded^ (vlax-safearray->list (vlax-variant-value (vla-explode AcDbBlkRef)))) (vla-delete AcDbBlkRef) (foreach o exploded^ (vlax-release-object o) ) (vlax-release-object AcDbBlkRef) ); insert_block ; here start (block_merge) (setq adoc (vla-get-activedocument (vlax-get-acad-object))) (vla-startUndomark adoc) (if (and (> (vl-list-length lst) 1) ; must have atlease 2 items (not (_validate_data)) ; validate data argument ) (progn (vlr-beep-reaction) (prompt "\ncheck your argument list.") ); progn (progn (setq blocks (vla-get-blocks adoc)) ; save some sysvars (setq savCmdecho (getvar "cmdecho")) (setq savAttdia (getvar "attdia")) (setq savAttreq (getvar "attreq")) ; disable sysvars (setvar "cmdecho" 0) (setvar "attdia" 0) (setvar "attreq" 0) (setq i 0 flag0 t) (while (and flag0 (< i (vl-list-length lst))) (setq pair (nth i lst)) (if (= i 0) ; insert host block (cond ((not (car pair)) (setq bname (cdr pair)) (cond ((tblsearch "block" (strip_file_name bname nil)) (setq host-bname bname flag0 nil) ); case ((setq fname (findfile (strcat (strip_file_name bname t) ".dwg"))) (command "._insert" fname "0,0,0" 1 1 0) (entdel (entlast)) (setq host-bname bname) ); case ); cond ); case ((setq bname (cdr pair)) (setq content (car pair)) (cond ((tblsearch "block" (strip_file_name bname nil)) (setq host-bname bname flag0 nil) ); case ((setq fname (findfile (strcat (strip_file_name content t) ".dwg"))) (command "._-insertcontent" fname (strip_file_name bname nil) "0,0,0" 1 1 0) (entdel (entlast)) (setq host-bname bname) ); case ); cond ); case ( t (setq flag0 nil) ); cas ); cond ; else, insert block to merge (progn (setq AcDbBlkTblRec (vla-item blocks host-bname)) (cond ((not (car pair)) (setq bname (cdr pair)) (cond ((tblsearch "block" (strip_file_name bname nil)) (insert_block nil AcDbBlkTblRec bname) ); case ((setq fname (findfile (strcat (strip_file_name bname t) ".dwg"))) (command "._insert" fname "0,0,0" 1 1 0) (insert_block t AcDbBlkTblRec fname) ); case ); cond ); case ((setq bname (cdr pair)) (setq content (car pair)) (cond ((tblsearch "block" (strip_file_name bname nil)) (insert_block nil AcDbBlkTblRec bname) ); case ((setq fname (findfile (strcat (strip_file_name content t) ".dwg"))) (command "._-insertcontent" fname (strip_file_name bname nil) "0,0,0" 1 1 0) (insert_block t AcDbBlkTblRec bname) ); case ); cond ); case ( t (setq flag0 nil) ) ); cond (vlax-release-object AcDbBlkTblRec) ); progn ); if (setq i (1+ i)) ); while ; restore sysvars (setvar "attreq" savAttreq) (setvar "attdia" savAttdia) (setvar "cmdecho" savCmdecho) (vlax-release-object blocks) ); progn ); if (vla-endUndoMark adoc) (vlax-release-object adoc) host-bname ; return host block name ); block_merge

Re: Combine 2 or more blocks into a new block using Toolpalettes

Moshe-A — Sat, 07 Jun 2025 19:40:52 GMT

@Hans_Knol ,

did some fine tunings

Re: Combine 2 or more blocks into a new block using Toolpalettes

Hans_Knol — Sat, 07 Jun 2025 20:33:10 GMT

Thanks Moshe, I will look to it in the comming day's and let you know.

Re: Combine 2 or more blocks into a new block using Toolpalettes

Moshe-A — Wed, 11 Jun 2025 12:34:35 GMT

@Hans_Knol wrote:
Thanks Moshe, I will look to it in the comming day's and let you know.

@Hans_Knol

You took long vocation? 😀

Re: Combine 2 or more blocks into a new block using Toolpalettes

Hans_Knol — Wed, 11 Jun 2025 13:15:11 GMT

haha, looks well Moshe, thanks!

Re: Combine 2 or more blocks into a new block using Toolpalettes

Moshe-A — Wed, 11 Jun 2025 15:48:19 GMT

@Hans_Knol ,

thank you, from your delayed and short reply i understand you dropped the all idea?

topic Re: Combine 2 or more blocks into a new block using Toolpalettes in Visual LISP, AutoLISP and General Customization Forum

Combine 2 or more blocks into a new block using Toolpalettes

Re: Combine 2 or more blocks into a new block using Toolpalettes

Re: Combine 2 or more blocks into a new block using Toolpalettes

Re: Combine 2 or more blocks into a new block using Toolpalettes

Re: Combine 2 or more blocks into a new block using Toolpalettes

Re: Combine 2 or more blocks into a new block using Toolpalettes

Re: Combine 2 or more blocks into a new block using Toolpalettes

Re: Combine 2 or more blocks into a new block using Toolpalettes

Re: Combine 2 or more blocks into a new block using Toolpalettes