Insert a copy of the block at the specified point. CopyRenameBlockV1-5.lsp /Lee Mac/

[Nikon]

Hi, everybody.
In this code, a copy of the block is superimposed on the original, 
how to change the code to insert a copy of the block at the specified point.

;;-----------------=={ Copy/Rename Block Reference }==------------------;;
;;----------------------------------------------------------------------;;
;;  Author:  Lee Mac, Copyright   2013  -  www.lee-mac.com              ;;
;;----------------------------------------------------------------------;;
;;  Version 1.5    -    05-07-2013                                      ;;
;;----------------------------------------------------------------------;;

(defun c:cb nil (LM:RenameBlockReference   t))
(defun c:rb nil (LM:RenameBlockReference nil))

(defun LM:RenameBlockReference ( cpy / *error* abc app dbc dbx def doc dxf new old prp src tmp vrs )

    (defun *error* ( msg )
        (if (and (= 'vla-object (type dbx)) (not (vlax-object-released-p dbx)))
            (vlax-release-object dbx)
        )
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )
    
    (while
        (progn
            (setvar 'errno 0)
            (setq src (car (entsel (strcat "\nSelect block reference to " (if cpy "copy & " "") "rename: "))))
            (cond
                (   (= 7 (getvar 'errno))
                    (princ "\nMissed, try again.")
                )
                (   (= 'ename (type src))
                    (setq dxf (entget src))
                    (cond
                        (   (/= "INSERT" (cdr (assoc 0 dxf)))
                            (princ "\nPlease select a block reference.")
                        )
                        (   (= 4 (logand 4 (cdr (assoc 70 (tblsearch "layer" (cdr (assoc 8 dxf)))))))
                            (princ "\nSelected block is on a locked layer.")
                        )
                    )
                )
            )
        )
    )
    (if (= 'ename (type src))
        (progn
            (setq app (vlax-get-acad-object)
                  doc (vla-get-activedocument app)
                  src (vlax-ename->vla-object src)
                  old (vlax-get-property src (if (vlax-property-available-p src 'effectivename) 'effectivename 'name))
                  tmp 0
            )
            (while (tblsearch "block" (setq def (strcat (vl-string-left-trim "*" old) "_" (itoa (setq tmp (1+ tmp)))))))
            (while
                (and (/= "" (setq new (getstring t (strcat "\nSpecify new block name <" def ">: "))))
                    (or (not (snvalid new))
                        (tblsearch "block" new)
                    )
                )
                (princ "\nBlock name invalid or already exists.")
            )
            (if (= "" new)
                (setq new def)
            )
            (setq dbx
                (vl-catch-all-apply 'vla-getinterfaceobject
                    (list app
                        (if (< (setq vrs (atoi (getvar 'acadver))) 16)
                            "objectdbx.axdbdocument"
                            (strcat "objectdbx.axdbdocument." (itoa vrs))
                        )
                    )
                )
            )
            (if (or (null dbx) (vl-catch-all-error-p dbx))
                (princ "\nUnable to interface with ObjectDBX.")
                (progn
                    (setq abc (vla-get-blocks doc)
                          dbc (vla-get-blocks dbx)
                    )
                    (vlax-invoke doc 'copyobjects (list (vla-item abc old)) dbc)
                    (if (wcmatch old "`**")
                        (vla-put-name (vla-item dbc (1- (vla-get-count dbc))) new)
                        (vla-put-name (vla-item dbc old) new)
                    )
                    (vlax-invoke dbx 'copyobjects (list (vla-item dbc new)) abc)
                    (vlax-release-object dbx)
                    (if cpy (setq src (vla-copy src)))
                    (if
                        (and
                            (vlax-property-available-p src 'isdynamicblock)
                            (= :vlax-true (vla-get-isdynamicblock src))
                        )
                        (progn
                            (setq prp (mapcar 'vla-get-value (vlax-invoke src 'getdynamicblockproperties)))
                            (vla-put-name src new)
                            (mapcar
                               '(lambda ( a b )
                                    (if (/= "ORIGIN" (strcase (vla-get-propertyname a)))
                                        (vla-put-value a b)
                                    )
                                )
                                (vlax-invoke src 'getdynamicblockproperties) prp
                            )
                        )
                        (vla-put-name src new)
                    )
                    (if (= :vlax-true (vla-get-isxref (setq def (vla-item (vla-get-blocks doc) new))))
                        (vla-reload def)
                    )
                    (if cpy (sssetfirst nil (ssadd (vlax-vla-object->ename src))))
                )
            )
        )
    )
    (princ)
)

;;----------------------------------------------------------------------;;

(vl-load-com)
(princ
    (strcat
        "\n:: CopyRenameBlock.lsp | Version 1.5 | \\U+00A9 Lee Mac "
        (menucmd "m=$(edtime,$(getvar,date),YYYY)")
        " www.lee-mac.com ::"
        "\n:: Available Commands:"
        "\n::    \"CB\"  -  Copy & Rename Block Reference."
        "\n::    \"RB\"  -  Rename Block Reference."
    )
)
(princ)

;;----------------------------------------------------------------------;;
;;                             End of File                              ;;
;;----------------------------------------------------------------------;;

 

[mhupp]

I had code that would pull from network location if you want a specific type of block. just remember if a block is already defined in the block library of the drawing it will use that instead of fully importing it again.

 

-edit

Might want to use steal instead.

https://www.lee-mac.com/steal.html

Edited Tuesday at 04:42 PM by mhupp

[Nikon]

28 minutes ago, mhupp said:

Might want to use steal instead

I need to select a block in the drawing, insert a copy of the block at a specified point, and rename the copy.

Edited Tuesday at 05:07 PM by Nikon

[CyberAngel]

Do you want to get rid of the "rename only" functionality?

 

If it were me, I'd add the new functionality near the end, after all the validating and bookkeeping is done. In the line with the sssetfirst command (not at that exact spot) the completed copy is added to the current selection set. You could expand that clause to ask for the new location and move the new block from its current location to the new coordinates. Disclaimer: I am only a hobbyist programmer, someone else may find a better solution.

 

 

 

[mhupp]

No error handling. just copies existing block and updates name and insertion point. change 0.0 0.0 0.0 to what you want or use getpoint.

 

;;----------------------------------------------------------------------------;;
;; Rename Block to New point
;; https://www.cadtutor.net/forum/topic/99155-insert-a-copy-of-the-block-at-the-specified-point-copyrenameblockv1-5lsp-lee-mac/
(defun c:CopyRenameBlock (/ ent obj newobj ed newname)
  (vl-load-com)
  (if (setq ent (car (entsel "\nSelect block: ")))
    (progn
      (setq obj (vlax-ename->vla-object ent))
      (setq newobj (vla-copy obj))
      (setq ed (entget (vlax-vla-object->ename newobj)))
      (setq newname (getstring T "\nNew block name: "))
      (entmod (subst (cons 2 newname) (assoc 2 ed) ed))
      (entmod (subst '(10 0.0 0.0 0.0) (assoc 10 ed) ed))
    )
  )
  (princ)
)

 

 

--edit 

rename Doesn't work

Edited Tuesday at 09:59 PM by mhupp

[BIGAL]

@mhupp I use Bricscad V25 and it did not work ? Old name stayed there did I miss a step.

 

I tried old fashioned method, it may not be the best solution, if block has attributes then could add a extra sub function to copy the existing values to the new inserted block. Also wants a "Does block exist check".

 

; https://www.cadtutor.net/forum/topic/99155-insert-a-copy-of-the-block-at-the-specified-point-copyrenameblockv1-5lsp-lee-mac/
; rename a existing block to a new name
; By AlanH June 2026

(defun c:AHRenblk ( / attreqold bname ent entg inspt oldangdir oldangunits rot scx scy)
  (setq attreqold (getvar 'attreq))
  (setq attreq 0)
  (setq oldangunits (getvar 'aunits))
  (setvar 'aunits 3)
  (setq oldangdir (getvar 'angdir))
  (setvar 'angdir 0)
  
  (setq ent (car (entsel "\nPick block to rename ")))
  
  (setq entg (entget ent))
  (setq bname (cdr (assoc 2 entg)))
  (setq inspt (cdr (assoc 10 entg)))
  (setq scx (cdr (assoc 41 entg)))
  (setq scy (cdr (assoc 42 entg)))
  (setq rot (cdr (assoc 50 entg)))
  
  (setq newname (getstring T "\nenter new block name "))
  
  (command "Bedit" bname "Bsaveas" newname "N" "Bclose" "S")
  (command "erase" ent "")
  (command "-insert" newname inspt scx scy rot)
  
  (setvar 'aunits oldangunits)
  (setvar 'angdir oldangdir)
  (princ)
)
(c:AHRenblk)

Yes will see flash on screen as Bedit is called.

[mhupp]

3 hours ago, BIGAL said:

@mhupp I use Bricscad V25 and it did not work ? Old name stayed there did I miss a step.

 

Yeah posted before checking it was 100%. I think because their isn't a block definition the rename fails or dosen't stay?

[Nikon]

On 10.06.2026 at 00:56, mhupp said:

No error handling. just copies existing block and updates name and insertion point. change 0.0 0.0 0.0 to what you want or use getpoint.

I would like to preserve the functionality of Lee Mac's code by simply inserting a copy of the block in the specified location and leaving the renaming.

Or move the copy relative to the original, if that makes it easier...

 

 

Edited 14 hours ago by Nikon

[mhupp]

I understand @Nikon I don't like to re-writting lee's code but will give it a try. will need to move new & src to the other side of / and update cb and rb calls.

 

(defun c:cb nil (LM:RenameBlockReference   t nil))
(defun c:rb nil (LM:RenameBlockReference nil nil))

(defun LM:RenameBlockReference ( cpy src / *error* abc app dbc dbx def doc dxf new old prp tmp vrs )

 

-Edit

Helper function "MB" at the bottom update entmod inside that  with the specified location . Right now its set to 0,0,0

 

Edited 7 hours ago by mhupp

[Nikon]

12 hours ago, mhupp said:

-Edit

Helper function "MB" at the bottom update entmod inside that  with the specified location . Right now its set to 0,0,0

Thanks @mhupp, but it's inconvenient to put a copy in 0.0.0. And if the block is located at the top right at a distance of 5 km from 0.0.0?

Then you will have to search for this copy in a large file for a long time. 

Edited 22 hours ago by Nikon

[mhupp]

Simple enough to use getpoint to make it dynamic. 

 

Update helper MB with 

(setq ed (entget (vlax-vla-object->ename newobj))) 	;same
(setq spt (getpoint "\nCopy to Location: "))		;add line
(entmod (subst (cons 10 spt) (assoc 10 ed) ed))		;update

 

but why not just copy block then use rb?

 

Edited 7 hours ago by mhupp

[Lee Mac]

3 hours ago, mhupp said:

but why not just copy block then use rb?

 

I wondered the same.

[mhupp]

Things we do to save a few clicks.

Edited 11 hours ago by mhupp

[Nikon]

I didn't think it was difficult or impossible to accomplish...

[BIGAL]

What I posted just renames an existing block does not copy or move just replaces at current location. Yes using bedit is an old way of doing things but it is normally instant. Old like me.

[yangguoshe]

8 hours ago, Nikon said:

I didn't think it was difficult or impossible to accomplish...

;;;You can call Master Leemac's code, but do not modify it

(defun c:ttt(/ CPB NEW-PT OBJ PT)
 (c:cb)
 (setq cpb (entlast))
 (setq pt  (cdr(assoc 10 (entget cpb))))
 (setq obj (vlax-ename->vla-object cpb))
 (setq new-pt (vlax-3d-point (getpoint pt "\n Specify the new location")))
 (vla-move obj (vlax-3d-point pt) new-pt)
 (princ)
)

[Nikon]

1 hour ago, yangguoshe said:

You can call Master Leemac's code, but do not modify it

@yangguoshe Thank you very much! 
This is a great addition to Lee Mac's code.
Thanks to all who responded!
Nothing is impossible   

Edited 22 minutes ago by Nikon