All Activity

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

Things we do to save a few clicks.

I wondered the same.

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?

In the future please use Code Tags for your Code, not Quote Tags. (<> in the editor toolbar). Do you have a link to the original code? Can you show what you edited? I second, please attach a before and after .dwg. @dlanorh hasn't been here in a few years.

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.

Sample drawing with correct layers and what your looking for? For mtext update the entmake with the following. 71 is the text justification defaulting to mid center. use \n for next line. (defun rh:em_mtxt (pt txt lyr ang hgt) (entmakex (list '(0 . "MTEXT") '(100 . "AcDbEntity") '(100 . "AcDbMText") (cons 8 lyr) (cons 50 ang) (cons 7 (getvar 'TEXTSTYLE)) (cons 1 txt) (cons 10 pt) (cons 40 hgt) (cons 50 ang) '(71 . 5) ) ) ) (rh:em_mtxt '(0 0 0) "hello\nthere" "0" 0 0.5) rh:2azimuth can be replace with (angtos l_ang 1 5)

I would maybe start again, if you look at this https://www.lee-mac.com/polyinfo.html it will find arcs etc in plines So if you want to label Lines, Arcs, Circles and Plines, you may need different code that looks at each entiity and correctly labels. I had a quick google and found a few programs I know that Kent Cooper has something similar to Lee's, but labels each segment. Search also "forums/autodesk".

I have this Lisp (Edited by me) that works really well. However I would really appreciated being able to incorporate three things beyond my skill level: - Arc Lengths with the prefix "A" - Mtext output rather than standard Text (I tried simply changing TEXT to MTEXT and a few other tweaks without success) - Remove trailing 00" (I already have a work around for this but it would be great to have incorporated into the existing lisp) Any help is greatly appreciated. ;;Bearing and Distance 4 © 2020 Ronald Harman (dlanorh) ;;Released under MIT Licence https://opensource.org/licenses/MIT (vl-load-com) (defun rh:R2D (r) (* 180.0 (/ r pi))) (defun gc:round (num prec) (if (zerop (setq prec (abs prec))) num (* prec (fix ((if (minusp num) - +) (/ num prec) 0.5))))) (defun rh:midpoint ( pt1 pt2 / pt3 ) (setq pt3 (mapcar '(lambda (x y) (/ (+ x y) 2)) pt1 pt2))) (defun rh:2azimuth ( a_brg / d a_azi) (setq d (fix a_brg)) (cond ((and (>= d 0) (< d 90)) (setq a_azi (- 90 a_brg))) ((and (>= d 90) (< d 180)) (setq a_azi (- 360 (- a_brg 90)))) ((and (>= d 180) (< d 270)) (setq a_azi (- 270 (- a_brg 180)))) ((and (>= d 270) (< d 360)) (setq a_azi (- 90 (- a_brg 360)))) ) (setq d a_azi) );_end_defun ; converts radian brg to dms text (defun rh:2dms ( r_brg rnd / d_brg d m s b_str) (setq d_brg (rh:2azimuth (rh:R2D r_brg)) d (fix d_brg) m (fix (* (rem d_brg 1.0) 60)) s (gc:round (* (rem (* (rem d_brg 1.0) 60) 1.0) 60) rnd) );_end_setq (if (>= s 59.5) (setq m (1+ m) s 0.0)) (if (= m 60) (setq d (1+ d) m 0)) (if (>= d 360) (setq d (- d 360))) (setq s (rtos s 2 0) m (itoa m) d (itoa d)) (if (< (atoi s) 10) (setq s (strcat "0" s))) (if (< (atoi m) 10) (setq m (strcat "0" m))) ;(while (< (strlen d) 3) (setq d (strcat "0" d))) (setq b_str (strcat d "\260" m "'" s "\"")) );_end_defun (defun rh:em_txt ( pt txt lyr ang tht d72 d73) (entmakex (list '(0 . "TEXT") '(100 . "AcDbEntity") '(100 . "AcDbText") (cons 8 lyr) (cons 50 ang) (cons 7 (getvar 'textstyle)) (cons 1 txt) (cons 10 pt) (cons 40 tht) (cons 72 d72) (cons 11 pt) (cons 73 d73) ) ) );end_defun ;;BEGIN MAIN ROUTINE (defun C:BAD ( / *error* sv_lst sv_vals tht b_lyr_lst d_lyr_lst lyr_idx d_rnd a_rnd lans pik lyr_e l_lst lt dv txt b_lyr d_lyr l_obj l_ang a_txt l_txt m_pt i_ang d_pt) (setvar "DIMZIN" 8) (defun *error* ( msg ) (mapcar 'setvar sv_lst sv_vals) (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error : " msg " occurred."))) (princ) );_end_*error*_defun (setq sv_lst (list 'cmdecho 'osmode 'dynmode 'dynprompt 'textsize) sv_vals (mapcar 'getvar sv_lst) );end_setq (mapcar 'setvar sv_lst '(0 0 3 1)) ;; User Variables (setq b_lyr_lst (list "Text_3.5 Bearing" "Text_2.8 Bearing Connection") ;; Bearing Layer list (first item is always default) d_lyr_lst (list "Text_3.5 Distance" "Text_2.8 Distance Connection") ;; Distance Layer list (first item is always default) lyr_idx 0 ;; Index for the above lists PLEASE DON'T CHANGE d_rnd 3 ;; Rounding for distance (Integer, number of decimal places) a_rnd 5.0 ;; Rounding for angles (Real Seconds of Arc) );end_setq (initget "Boundaries Connections") (setq lans (cond ( (getkword (strcat "\nUse Boundaries (" (nth lyr_idx b_lyr_lst)" & " (nth lyr_idx d_lyr_lst) ") or Connections Layers : ? [Boundaries/Connections] <Boundaries>"))) ("Boundaries"))) (if (= lans "Connections") (setq lyr_idx 1 pik "Boundaries") (setq pik "Connections")) (setq b_lyr (nth lyr_idx b_lyr_lst) d_lyr (nth lyr_idx d_lyr_lst)) (foreach lyr (list b_lyr d_lyr) (if (not (tblsearch "layer" lyr)) (setq lyr_e T l_lst (cons lyr l_lst)))) (cond (lyr_e (if (= (length l_lst) 2) (setq lt "layers" dv " , ") (setq lt "layer" dv "")) (setq txt (strcat "MISSING LAYERS\n\nOption " lans " " lt " : ")) (mapcar '(lambda (x) (setq txt (strcat txt x dv))) l_lst) (setq txt (vl-string-right-trim " ," txt)) (alert (strcat txt "\n\nPlease rectify missing " lt " or re-run\nand select " pik " option")) ) );end_cond (missing layers) (initget 6) (setq tht (cond ( (getreal (strcat "\nEnter Text Size : <" (rtos (getvar 'textsize) 2 3) ">"))) ( (getvar 'textsize)))) (cond ( (not lyr_e) (princ "\nSelect Lines : ") (setq ss (ssget '((0 . "LINE")))) (cond (ss (repeat (setq cnt (sslength ss)) (setq l_obj (vlax-ename->vla-object (setq ent (ssname ss (setq cnt (1- cnt))))) elst (entget ent) l_ang (angle '(0.0 0.0 0.0) (vlax-curve-getfirstderiv ent 0)) a_txt (rh:2dms l_ang a_rnd) l_txt (rtos (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent)) 2 d_rnd) m_pt (rh:midpoint (vlax-get l_obj 'startpoint) (vlax-get l_obj 'endpoint)) );_end_setq (setq i_ang l_ang) (if (and (>= l_ang (* pi 0.5)) (< l_ang (* pi 1.5))) (setq i_ang (- l_ang pi) d_pt (polar m_pt (- i_ang (* pi 0.5)) (* tht 0.3))) (setq d_pt (polar m_pt (- i_ang (* pi 0.5)) (* tht 0.3))) );end_if (rh:em_txt m_pt a_txt b_lyr i_ang tht 1 1) (rh:em_txt d_pt l_txt d_lyr i_ang tht 1 3) );end_repeat ) );end_cond ) );end_cond (mapcar 'setvar sv_lst sv_vals) (princ) );_end_defun (princ)

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 MBlisp.mp4 CopyRenameBlockV1-5.5.lsp

Ye it was originally an AutoCAD file, but I ended up just redrawing it instead of fiddling around with it but with your input I think I can just remove it in the future. Thanks fellas

Yep, that's what I ended up doing...lol...just redrew it.

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...

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

@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.

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

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.

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

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

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 ;; ;;----------------------------------------------------------------------;;

You might want to look into using Visual Studio Code, it is replacing the VLIDE in newer AutoCAD versions. I have some links to more information in this thread...

Thanks again. I just need to remember that CNTL F9 only works when I do not mouse-click on vlisp console first.

Thanks. Good stuff there.

Perhaps my tutorial on debugging with the VLIDE will help? https://lee-mac.com/debugvlide.html

Thanks for responding. That is correct. I put (vl-bt) in my *error* functions, otherwise I have zero idea where the error occurred. However, I don't know the name of the variable in the errant line of code, only the values. That isn't always easy to spot. I was able to load and run code thru the vlide, but using CNTL-F9 did not show the line where the error occurred, just this dialog. And setting "Break on Error" didn't do what AI told me it would...When it crashes, VLIDE will freeze the execution and highlight the problematic line in your source code.