@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
