All Activity

@CivilTechSource

found this one under a layer of dust : ;;; https://lispbox.wordpress.com/2016/05/01/remove-any-unloaded-unreferenced-xrefsimagespdfsdgns-and-dwfs-in-a-one-click/ ;;; Remove any unloaded (unreferenced) XREFs,IMAGE's,PDF's,DGN's and DWF's in a one click ;;; Combined from existing subroutines by Igal Averbuh 2016 ;;; Based on https://www.theswamp.org/index.php?topic=51337.0 ;;; With respect to T.Willey ; Detach any unloaded (unreferenced) XREFs (defun C:dux () (vlax-for BIND_xrefname (vla-get-blocks (vla-get-ActiveDocument (vlax-get-Acad-object))) (if (= (vla-get-isxref BIND_xrefname) ':vlax-true) (progn (setq BIND_cont (entget (vlax-vla-object->ename BIND_xrefname)) BIND_cont (tblsearch "BLOCK" (cdr (assoc 2 BIND_cont))) ) (if (or (= (cdr (assoc 70 BIND_cont)) 4) (= (cdr (assoc 70 BIND_cont)) 12)) (vla-Detach BIND_xrefname) ) ) ) ) ) (defun c:RID ( / isDefReferenced dict data name tData lst imName ) ; Remove image definition of unreferenced and unloaded definitions. (defun isDefReferenced ( aEname / cnt data ) (setq cnt 0) (foreach i (entget aEname) (if (and (equal (car i) 330) (setq data (entget (cdr i))) (= (cdr (assoc 0 data)) "IMAGEDEF_REACTOR") ) (foreach j data (if (and (equal (car j) 330) (entget (cdr j))) (setq cnt (+ cnt 1)) ) ) ) ) (> cnt 0) ) ;------------------------------------------------------- (setq dict (namedobjdict)) (setq data (entget dict)) (setq name "ACAD_IMAGE_DICT") (if (setq data (dictsearch dict name)) (foreach i data (cond ((and imName (equal (car i) 350)) ;check to see if unreferenced or unload (setq tData (entget (cdr i))) (if (or (equal (cdr (assoc 280 tData)) 0) (not (isDefReferenced (cdr i)))) (setq lst (cons (cons imName (cdr i)) lst)) ) ) ((equal (car i) 3) (setq imName (cdr i))) (t (setq imName nil)) ) ) ) (if lst (progn (setq dict (cdr (assoc -1 data))) (foreach i lst (dictremove dict (car i)) (entdel (cdr i)) ) (prompt (strcat "\n Removed " (itoa (length lst)) " image definition(s).")) ) ) (princ) ) (defun c:RPD ( / isDefReferenced dict data name tData lst imName ) ; Remove pdf definition of unreferenced and unloaded definitions. (defun isDefReferenced ( aEname / cnt data ) (setq cnt 0) (foreach i (entget aEname) (if (and (equal (car i) 330) (setq data (entget (cdr i))) (= (cdr (assoc 0 data)) "IMAGEDEF_REACTOR") ) (foreach j data (if (and (equal (car j) 330) (entget (cdr j))) (setq cnt (+ cnt 1)) ) ) ) ) (> cnt 0) ) ;------------------------------------------------------- (setq dict (namedobjdict)) (setq data (entget dict)) (setq name "ACAD_PDFDEFINITIONS") (if (setq data (dictsearch dict name)) (foreach i data (cond ((and imName (equal (car i) 350)) ;check to see if unreferenced or unload (setq tData (entget (cdr i))) (if (or (equal (cdr (assoc 280 tData)) 0) (not (isDefReferenced (cdr i)))) (setq lst (cons (cons imName (cdr i)) lst)) ) ) ((equal (car i) 3) (setq imName (cdr i))) (t (setq imName nil)) ) ) ) (if lst (progn (setq dict (cdr (assoc -1 data))) (foreach i lst (dictremove dict (car i)) (entdel (cdr i)) ) (prompt (strcat "\n Removed " (itoa (length lst)) " pdf definition(s).")) ) ) (princ) ) (defun c:RDD ( / isDefReferenced dict data name tData lst imName ) ; Remove dgn definition of unreferenced and unloaded definitions. (defun isDefReferenced ( aEname / cnt data ) (setq cnt 0) (foreach i (entget aEname) (if (and (equal (car i) 330) (setq data (entget (cdr i))) (= (cdr (assoc 0 data)) "IMAGEDEF_REACTOR") ) (foreach j data (if (and (equal (car j) 330) (entget (cdr j))) (setq cnt (+ cnt 1)) ) ) ) ) (> cnt 0) ) ;------------------------------------------------------- (setq dict (namedobjdict)) (setq data (entget dict)) (setq name "ACAD_DGNDEFINITIONS") (if (setq data (dictsearch dict name)) (foreach i data (cond ((and imName (equal (car i) 350)) ;check to see if unreferenced or unload (setq tData (entget (cdr i))) (if (or (equal (cdr (assoc 280 tData)) 0) (not (isDefReferenced (cdr i)))) (setq lst (cons (cons imName (cdr i)) lst)) ) ) ((equal (car i) 3) (setq imName (cdr i))) (t (setq imName nil)) ) ) ) (if lst (progn (setq dict (cdr (assoc -1 data))) (foreach i lst (dictremove dict (car i)) (entdel (cdr i)) ) (prompt (strcat "\n Removed " (itoa (length lst)) " dgn definition(s).")) ) ) (princ) ) (defun c:RWD ( / isDefReferenced dict data name tData lst imName ) ; Remove dwf definition of unreferenced and unloaded definitions. (defun isDefReferenced ( aEname / cnt data ) (setq cnt 0) (foreach i (entget aEname) (if (and (equal (car i) 330) (setq data (entget (cdr i))) (= (cdr (assoc 0 data)) "IMAGEDEF_REACTOR") ) (foreach j data (if (and (equal (car j) 330) (entget (cdr j))) (setq cnt (+ cnt 1)) ) ) ) ) (> cnt 0) ) ;------------------------------------------------------- (setq dict (namedobjdict)) (setq data (entget dict)) (setq name "ACAD_DWFDEFINITIONS") (if (setq data (dictsearch dict name)) (foreach i data (cond ((and imName (equal (car i) 350)) ;check to see if unreferenced or unload (setq tData (entget (cdr i))) (if (or (equal (cdr (assoc 280 tData)) 0) (not (isDefReferenced (cdr i)))) (setq lst (cons (cons imName (cdr i)) lst)) ) ) ((equal (car i) 3) (setq imName (cdr i))) (t (setq imName nil)) ) ) ) (if lst (progn (setq dict (cdr (assoc -1 data))) (foreach i lst (dictremove dict (car i)) (entdel (cdr i)) ) (prompt (strcat "\n Removed " (itoa (length lst)) " dwf definition(s).")) ) ) (princ) ) (defun c:eid () (c:dux) (c:rid) (c:rpd) (c:rdd) (c:rwd) (vl-cmdf "_.externalreferences") (princ) ) (c:eid)

I think I solved it. Is this the most optimal way? (while continue (command "-INSERT" GV-Block pause "" "" "0") (if (= (getvar "CMDSTAT") 0) (setq continue nil) ) )

Hi again, Looking to create a lisp that will bring a block into a drawing and will loop and keep adding it. The catch is that I want to see the visual of the block similar to the -insert command. So I managed to achieve the visual by adding the pause. But how do I make the while loop keep going without the getpoint? Is there a way I could check for pause? Thanks again (while (setq ins (getpoint "\nSpecify point for block (ENTER to exit): ")) (command "-INSERT" GV-Block pause "" "" "0") )

You're welcome @X11start If you want options for rename you can try this copy for dragons version ;;; copy for dragons- rlx 2025-10-18 (defun c:cfd ( / this-dwg ss other-dwg blocknames-in-selectionset blocknames-in-other-dwg duplicate-blocknames dbx-doc) (setq this-dwg (vla-get-ActiveDocument (vlax-get-acad-object))) (if (and (setq ss (ssget)) (setq other-dwg (getfiled "Copy SS to:" "" "dwg" 0))) (progn (if (vl-consp (setq blocknames-in-selectionset (Get_SS_BlockNames ss))) (setq blocknames-in-selectionset (mapcar 'strcase blocknames-in-selectionset))) (if (vl-consp (setq blocknames-in-other-dwg (Get_DBX_Blocknames other-dwg))) (setq blocknames-in-other-dwg (mapcar 'strcase blocknames-in-other-dwg))) (setq duplicate-blocknames (compare_block_names blocknames-in-selectionset blocknames-in-other-dwg)) (if (vl-consp duplicate-blocknames) (progn (dplm duplicate-blocknames "Duplicated block names : ") ;;; (if (yes_no "Copy anyway?") (ctd ss other-dwg) (princ"\nBite me...") ) (setq inp (cfl (list "1 - Copy anyway" "2 - Rename blocks in this dwg" "3 - Rename blocks in other dwg" "4 - Never mind"))) (cond ((void inp) (princ "\nNever mind")) ((wcmatch inp "1*") (ctd ss other-dwg)) ((wcmatch inp "2*") (foreach b duplicate-blocknames (rename_block_definition b)) (ctd ss other-dwg)) ((wcmatch inp "3*") (dbx_rename_block_definitions duplicate-blocknames other-dwg) (ctd ss other-dwg)) (t (princ"\nBite me...")) ) ) (ctd ss other-dwg) ) ) ) (princ) ) ; check if $member exists in (vla-) %collection (defun Collection-Member ( $member %collection / result) (if (vl-catch-all-error-p (setq result (vl-catch-all-apply 'vla-item (list %collection $member)))) nil result)) (defun create_unique_blockname ( $bn / i bn) (setq i 0)(while (tblsearch "block" (setq bn (strcat $bn "_" (itoa (setq i (1+ i))))))) bn) (defun rename_block_definition ( $bn / bn ) (if (and (not (void $bn)) (tblsearch "block" $bn)) (vla-put-name (Collection-Member $bn (vla-get-blocks (vla-get-ActiveDocument (vlax-get-acad-object)))) (setq bn (create_unique_blockname $bn)))) bn) (defun compare_block_names (a b / c) (and (vl-consp a) (vl-consp b) (foreach item a (if (member item b) (setq c (cons item c))))) c) (defun Get_SS_BlockNames ( ss / n l) (foreach o (ss->ol ss) (if (and (block-p o)(not (member (setq n (block-n o)) l))) (setq l (cons n l)))) l) (defun SS->OL (ss / i l)(setq i 0)(repeat (sslength ss)(setq l (cons (vlax-ename->vla-object (ssname ss i)) l) i (1+ i))) l) (defun void (x) (or (eq x nil)(and (listp x)(not (vl-consp x)))(and (eq 'STR (type x))(eq "" (vl-string-trim " \t\r\n" x))))) ; (block-p (vlax-ename->vla-object (car (entsel)))) (defun block-p (o) (and (= 'vla-object (type O))(eq (vla-get-objectname O) "AcDbBlockReference"))) (defun block-n (o) (if (and (= 'vla-object (type O))(eq (vla-get-objectname O) "AcDbBlockReference")) (if (vlax-property-available-p o 'EffectiveName)(vla-Get-EffectiveName o)(vla-Get-Name o)) nil)) ; (yes_no "Do you like snow") (defun yes_no ( $m / f p i r ) (and (= (type $m) 'STR) (setq f (vl-filename-mktemp ".dcl")) (setq p (open f "w")) (write-line (strcat "yesno:dialog{label=\"" $m "?\";ok_cancel;}") p) (progn (close p)(gc) t) (setq i (load_dialog f)) (new_dialog "yesno" i) (progn (action_tile "accept" "(done_dialog 1)")(action_tile "cancel" "(done_dialog 0)") (setq r (start_dialog))(unload_dialog i)(vl-file-delete f) t)(if (= r 1) t nil))) ;;; choose from list (cfl '("1""2""3")) (defun cfl (l / f p d r) (and (setq p (open (setq f (vl-filename-mktemp ".dcl")) "w")) (princ "cfl:dialog{label=\"Choose\";:list_box{key=\"lb\";width=40;}ok_cancel;}" p) (not (setq p (close p)))(< 0 (setq d (load_dialog f)))(new_dialog "cfl" d) (progn (start_list "lb")(mapcar 'add_list l)(end_list)(action_tile "lb" "(setq r (nth (atoi $value) l))(done_dialog 1)") (action_tile "accept" "(setq r (get_tile \"lb\"))(done_dialog 1)")(action_tile "cancel" "(setq r nil)(done_dialog 0)") (start_dialog)(unload_dialog d)(vl-file-delete f))) (cond ((= r "") nil)(r r)(t nil))) ;;; display list (plus message) (defun dplm (l m / f p d w) (and (vl-consp l) (setq l (mapcar 'vl-princ-to-string l)) (setq w (+ 5 (apply 'max (mapcar 'strlen l)))) (setq p (open (setq f (vl-filename-mktemp ".dcl")) "w")) (princ (strcat "cfl:dialog{label=\"" m "\";:list_box {key=\"lb\";" "width="(itoa w)";}ok_only;}") p)(not (setq p (close p)))(< 0 (setq d (load_dialog f)))(new_dialog "cfl" d)(progn (start_list "lb") (mapcar 'add_list l)(end_list)(action_tile "accept" "(done_dialog)")(start_dialog)(unload_dialog d)(vl-file-delete f)))) ;;; copy to drawing (defun ctd ( ss dwg / ss->ol dbx_ver acApp acDoc dbx object-list object-safe-array) (defun SS->OL (ss / i l) (setq i 0)(repeat (sslength ss)(setq l (cons (vlax-ename->vla-object (ssname ss i)) l) i (1+ i))) l) (defun dbx_ver ( / v) (strcat "objectdbx.axdbdocument" (if (< (setq v (atoi (getvar 'acadver))) 16) "" (strcat "." (itoa v))))) (setq acApp (vlax-get-acad-object) acDoc (vla-get-ActiveDocument acApp)) (setq dbx (vl-catch-all-apply 'vla-getinterfaceobject (list acApp (dbx_ver)))) (vla-open dbx dwg) ; put all objects in a list (setq object-list (ss->ol ss)) ; put list with objects in a safe array (setq object-safe-array (vlax-make-safearray vlax-vbobject (cons 0 (1- (length object-list))))) (vl-catch-all-apply 'vlax-safearray-fill (list object-safe-array object-list)) ; copy objects to dbx-drawing (vla-CopyObjects acDoc object-safe-array (vla-get-ModelSpace dbx)) (vl-catch-all-apply 'vla-saveas (list dbx dwg)) (vl-catch-all-apply 'vlax-release-object (list dbx)) (setq object-list nil object-safe-array nil) (princ) ) ;;; (dbx_rename_block_definitions ("block-a" "block-b" "block-c") "c:\\temp\\my-old-blocks-drawing.dwg") (defun dbx_rename_block_definitions ( lst dwg / dbx_ver acApp acDoc dbx dbx-blocks) (defun dbx_ver ( / v) (strcat "objectdbx.axdbdocument" (if (< (setq v (atoi (getvar 'acadver))) 16) "" (strcat "." (itoa v))))) (setq acApp (vlax-get-acad-object) acDoc (vla-get-ActiveDocument acApp)) (setq dbx (vl-catch-all-apply 'vla-getinterfaceobject (list acApp (dbx_ver)))) (vla-open dbx dwg) (setq dbx-blocks (vla-get-blocks dbx)) (foreach blk lst (if (Collection-Member blk dbx-blocks) (vla-put-name (Collection-Member blk dbx-blocks) (create_unique_blockname blk)))) (vl-catch-all-apply 'vla-saveas (list dbx dwg)) (vl-catch-all-apply 'vlax-release-object (list dbx)) (princ) ) ; test : (setq lst (GetDocBlockNames (vla-get-ActiveDocument (vlax-get-acad-object)))) ; returns sorted list (uppercase) like : ("BLOCK_A" "BLOCK_B" ...) (defun GetDocBlockNames (d / o n l) (vlax-for o (vla-get-blocks d)(if (and (= :vlax-false (vla-get-isxref o))(= :vlax-false (vla-get-islayout o)) (snvalid (setq n (vla-get-name o)) 0))(setq l (cons (strcase n) l))))(if (vl-consp l)(acad_strlsort l))) (defun Get_DBX_Blocknames ( doc-name / lst v objectdbx-document) (cond ((not (eq (type doc-name) 'STR)) (princ (strcat "\nInvalid filename : " (vl-princ-to-string doc-name)))) ((not (findfile doc-name)) (princ (strcat "\nFile not found : " (vl-princ-to-string doc-name)))) (t (vlax-for doc (vla-get-Documents (vlax-get-acad-object)) (and (eq (strcase (vla-get-fullname doc)) (strcase doc-name))(setq objectdbx-document doc))) (cond ((eq (type objectdbx-document) 'VLA-OBJECT)) ((not (setq objectdbx-document (vlax-create-object (strcat "objectdbx.axdbdocument" (if (< (setq v (atoi (getvar 'acadver))) 16) "" (strcat "." (itoa v))))))) (princ "\nUnable to start object dbx")) ((vl-catch-all-error-p (vl-catch-all-apply 'vla-open (list objectdbx-document doc-name))) (princ (strcat "\nOdbx error - unable to acces : " doc-name))) (t (setq lst (GetDocBlockNames objectdbx-document))) ) ) ) (vl-catch-all-apply 'vla-close (list objectdbx-document :vlax-False)) (if (and (= 'vla-object (type objectdbx-document))(not (vlax-object-released-p objectdbx-document))) (vlax-release-object objectdbx-document)) (if (vl-consp lst) (mapcar 'strcase lst)) ) (c:cfd)

In your drawing, area 1 is, as stated by @Steven P, a block which has lines from an exploded hatch. Area 2 is a standard hatch pattern HEX and scale of 1. If you measure one side of the hexagon in each of the areas, you will find the scale of area 1 is equivalent to a scale of 10. I don't know why your hatch in area 2 disappears when you scale it. Perhaps you are trying a scale number that is too large.

Thank you very much Steven P for your reply

I tested both files: the 2nd one (the one that allows renaming), I don't understand how it works: I can't rename the block already present on the first drawing. ... but the first lisp is more than sufficient: from now on, whenever I want to do a "Copy and paste at the original coordinates", I will definitely use 'capdf.lsp'! An 'Alert' that warns me there are blocks with the same name already present in the 2nd drawing... is more than enough to avoid making dangerous mistakes! I thank you immensely, RLX, for all the work you have done! A note (I also say this for other users): remember to add (vl-load-com), if it is not already included in the auto start when launching AutoCAD.

@Ish, I modified the code from the fist post, just copy it again and try it. Now, you will get the desired elevation values (picture 1, the red rectangle). Best regards.

no problem thanks for demonstrating how to do it,

I need to draw hexagonal pyramid like this in AutoCAD. So i used Pyramid command where I got hexagon as top view and a triangular shape at the front view at first. Now I need to turn the first front view as shown in the figure (attached). When I used rotate command, the tracking lines showing angles is not coming. here there is no angle specified. we need to turn it manually so that the o'd' line should be horizontal in the second front view. help me drawing like this in AutoCAD. What i mean is, while in rotate3D command, i selected the object, then VIEW, then specified the base point, then its asking for angle. here angle is not specified. we need to rotate the first front view such that the line O'D' becomes horizontal. any way of doing it. please help. The angle tracking lines are not coming as we rotate. Polar tracking is ON. please help. I need to rotate first front view like the one as in second front view in image shown. Thank you Rotate3D.mp4

Can you post a drawing?

Please place Code in Tags in the future. (<> in the editor toolbar)

It might be the way it downloaded for me, but the original hatch, 1, appears to be a block (anonymous block), so when you apply the format painter all it will copy are settings common to a block and a hatch - layer, line type and so. Explode the block and it turns into lines rather than a hatch.

maybe something like this (untested) ;;; copy & paste for dummies - rlx 2025-10-18 (defun c:capfd ( / this-dwg ss other-dwg blocknames-in-selectionset blocknames-in-other-dwg duplicate-blocknames) (setq this-dwg (vla-get-ActiveDocument (vlax-get-acad-object))) (if (and (setq ss (ssget)) (setq other-dwg (getfiled "Copy SS to:" "" "dwg" 0))) (progn (setq blocknames-in-selectionset (Get_SS_BlockNames ss)) (setq blocknames-in-other-dwg (Get_DBX_Blocknames other-dwg)) (setq duplicate-blocknames (compare_block_names blocknames-in-selectionset blocknames-in-other-dwg)) (if (vl-consp duplicate-blocknames) (progn (dplm duplicate-blocknames "Duplicated block names : ") (if (yes_no "Copy anyway?") (ctd ss other-dwg) (princ"\nBite me...") ) ) (ctd ss other-dwg) ) ) ) (princ) ) (defun compare_block_names (a b / c) (and (vl-consp a) (vl-consp b) (foreach item a (if (member item b) (setq c (cons item c))))) c) (defun Get_SS_BlockNames ( ss / n l) (foreach o (ss->ol ss) (if (and (block-p o)(not (member (setq n (block-n o)) l))) (setq l (cons n l)))) l) (defun SS->OL (ss / i l)(setq i 0)(repeat (sslength ss)(setq l (cons (vlax-ename->vla-object (ssname ss i)) l) i (1+ i))) l) ; (block-p (vlax-ename->vla-object (car (entsel)))) (defun block-p (o) (and (= 'vla-object (type O))(eq (vla-get-objectname O) "AcDbBlockReference"))) (defun block-n (o) (if (and (= 'vla-object (type O))(eq (vla-get-objectname O) "AcDbBlockReference")) (if (vlax-property-available-p o 'EffectiveName)(vla-Get-EffectiveName o)(vla-Get-Name o)) nil)) ; (yes_no "Do you like snow") (defun yes_no ( $m / f p i r ) (and (= (type $m) 'STR) (setq f (vl-filename-mktemp ".dcl")) (setq p (open f "w")) (write-line (strcat "yesno:dialog{label=\"" $m "?\";ok_cancel;}") p) (progn (close p)(gc) t) (setq i (load_dialog f)) (new_dialog "yesno" i) (progn (action_tile "accept" "(done_dialog 1)")(action_tile "cancel" "(done_dialog 0)") (setq r (start_dialog))(unload_dialog i)(vl-file-delete f) t)(if (= r 1) t nil))) ;;; display list (plus message) (defun dplm (l m / f p d w) (and (vl-consp l) (setq l (mapcar 'vl-princ-to-string l)) (setq w (+ 5 (apply 'max (mapcar 'strlen l)))) (setq p (open (setq f (vl-filename-mktemp ".dcl")) "w")) (princ (strcat "cfl:dialog{label=\"" m "\";:list_box {key=\"lb\";" "width="(itoa w)";}ok_only;}") p)(not (setq p (close p)))(< 0 (setq d (load_dialog f)))(new_dialog "cfl" d)(progn (start_list "lb") (mapcar 'add_list l)(end_list)(action_tile "accept" "(done_dialog)")(start_dialog)(unload_dialog d)(vl-file-delete f)))) ;;; copy to drawing (defun ctd ( ss dwg / ss->ol dbx_ver acApp acDoc dbx object-list object-safe-array) (defun SS->OL (ss / i l) (setq i 0)(repeat (sslength ss)(setq l (cons (vlax-ename->vla-object (ssname ss i)) l) i (1+ i))) l) (defun dbx_ver ( / v) (strcat "objectdbx.axdbdocument" (if (< (setq v (atoi (getvar 'acadver))) 16) "" (strcat "." (itoa v))))) (setq acApp (vlax-get-acad-object) acDoc (vla-get-ActiveDocument acApp)) (setq dbx (vl-catch-all-apply 'vla-getinterfaceobject (list acApp (dbx_ver)))) (vla-open dbx dwg) ; put all block objects in a list (setq object-list (ss->ol ss)) ; put list with objects in a safe array (setq object-safe-array (vlax-make-safearray vlax-vbobject (cons 0 (1- (length object-list))))) (vl-catch-all-apply 'vlax-safearray-fill (list object-safe-array object-list)) ; copy objects to dbx-drawing (vla-CopyObjects acDoc object-safe-array (vla-get-ModelSpace dbx)) (vl-catch-all-apply 'vla-saveas (list dbx dwg)) (vl-catch-all-apply 'vlax-release-object (list dbx)) (setq object-list nil object-safe-array nil) (princ) ) ; test : (setq lst (GetDocBlockNames (vla-get-ActiveDocument (vlax-get-acad-object)))) ; returns sorted list (uppercase) like : ("BLOCK_A" "BLOCK_B" ...) (defun GetDocBlockNames (d / o n l) (vlax-for o (vla-get-blocks d)(if (and (= :vlax-false (vla-get-isxref o))(= :vlax-false (vla-get-islayout o)) (snvalid (setq n (vla-get-name o)) 0))(setq l (cons (strcase n) l))))(if (vl-consp l)(acad_strlsort l))) (defun Get_DBX_Blocknames ( doc-name / lst v objectdbx-document) (cond ((not (eq (type doc-name) 'STR)) (princ (strcat "\nInvalid filename : " (vl-princ-to-string doc-name)))) ((not (findfile doc-name)) (princ (strcat "\nFile not found : " (vl-princ-to-string doc-name)))) (t (vlax-for doc (vla-get-Documents (vlax-get-acad-object)) (and (eq (strcase (vla-get-fullname doc)) (strcase doc-name))(setq objectdbx-document doc))) (cond ((eq (type objectdbx-document) 'VLA-OBJECT)) ((not (setq objectdbx-document (vlax-create-object (strcat "objectdbx.axdbdocument" (if (< (setq v (atoi (getvar 'acadver))) 16) "" (strcat "." (itoa v))))))) (princ "\nUnable to start object dbx")) ((vl-catch-all-error-p (vl-catch-all-apply 'vla-open (list objectdbx-document doc-name))) (princ (strcat "\nOdbx error - unable to acces : " doc-name))) (t (setq lst (GetDocBlockNames objectdbx-document))) ) ) ) (vl-catch-all-apply 'vla-close (list objectdbx-document :vlax-False)) (if (and (= 'vla-object (type objectdbx-document))(not (vlax-object-released-p objectdbx-document))) (vlax-release-object objectdbx-document)) (if (vl-consp lst) (mapcar 'strcase lst)) ) and if you want the rename version : ;;; copy for lazy dummies - rlx 2025-10-18 (defun c:cfld ( / this-dwg ss other-dwg blocknames-in-selectionset blocknames-in-other-dwg duplicate-blocknames) (setq this-dwg (vla-get-ActiveDocument (vlax-get-acad-object))) (if (and (setq ss (ssget)) (setq other-dwg (getfiled "Copy SS to:" "" "dwg" 0))) (progn (if (vl-consp (setq blocknames-in-selectionset (Get_SS_BlockNames ss))) (setq blocknames-in-selectionset (mapcar 'strcase blocknames-in-selectionset))) (if (vl-consp (setq blocknames-in-other-dwg (Get_DBX_Blocknames other-dwg))) (setq blocknames-in-other-dwg (mapcar 'strcase blocknames-in-other-dwg))) (setq duplicate-blocknames (compare_block_names blocknames-in-selectionset blocknames-in-other-dwg)) (if (vl-consp duplicate-blocknames) (progn (dplm duplicate-blocknames "Duplicated block names : ") ;;; (if (yes_no "Copy anyway?") (ctd ss other-dwg) (princ"\nBite me...") ) (if (yes_no "Rename duplicates?") (progn (foreach b duplicate-blocknames (rename_block_definition b)) (ctd ss other-dwg) ) (princ"\nBite me...") ) ) (ctd ss other-dwg) ) ) ) (princ) ) ; check if $member exists in (vla-) %collection (defun Collection-Member ( $member %collection / result) (if (vl-catch-all-error-p (setq result (vl-catch-all-apply 'vla-item (list %collection $member)))) nil result)) (defun create_unique_blockname ( $bn / i bn) (setq i 0)(while (tblsearch "block" (setq bn (strcat $bn "_" (itoa (setq i (1+ i))))))) bn) (defun rename_block_definition ( $bn / bn ) (if (and (not (void $bn)) (tblsearch "block" $bn)) (vla-put-name (Collection-Member $bn (vla-get-blocks (vla-get-ActiveDocument (vlax-get-acad-object)))) (setq bn (create_unique_blockname $bn)))) bn) (defun compare_block_names (a b / c) (and (vl-consp a) (vl-consp b) (foreach item a (if (member item b) (setq c (cons item c))))) c) (defun Get_SS_BlockNames ( ss / n l) (foreach o (ss->ol ss) (if (and (block-p o)(not (member (setq n (block-n o)) l))) (setq l (cons n l)))) l) (defun SS->OL (ss / i l)(setq i 0)(repeat (sslength ss)(setq l (cons (vlax-ename->vla-object (ssname ss i)) l) i (1+ i))) l) ; (block-p (vlax-ename->vla-object (car (entsel)))) (defun block-p (o) (and (= 'vla-object (type O))(eq (vla-get-objectname O) "AcDbBlockReference"))) (defun block-n (o) (if (and (= 'vla-object (type O))(eq (vla-get-objectname O) "AcDbBlockReference")) (if (vlax-property-available-p o 'EffectiveName)(vla-Get-EffectiveName o)(vla-Get-Name o)) nil)) ; (yes_no "Do you like snow") (defun yes_no ( $m / f p i r ) (and (= (type $m) 'STR) (setq f (vl-filename-mktemp ".dcl")) (setq p (open f "w")) (write-line (strcat "yesno:dialog{label=\"" $m "?\";ok_cancel;}") p) (progn (close p)(gc) t) (setq i (load_dialog f)) (new_dialog "yesno" i) (progn (action_tile "accept" "(done_dialog 1)")(action_tile "cancel" "(done_dialog 0)") (setq r (start_dialog))(unload_dialog i)(vl-file-delete f) t)(if (= r 1) t nil))) ;;; display list (plus message) (defun dplm (l m / f p d w) (and (vl-consp l) (setq l (mapcar 'vl-princ-to-string l)) (setq w (+ 5 (apply 'max (mapcar 'strlen l)))) (setq p (open (setq f (vl-filename-mktemp ".dcl")) "w")) (princ (strcat "cfl:dialog{label=\"" m "\";:list_box {key=\"lb\";" "width="(itoa w)";}ok_only;}") p)(not (setq p (close p)))(< 0 (setq d (load_dialog f)))(new_dialog "cfl" d)(progn (start_list "lb") (mapcar 'add_list l)(end_list)(action_tile "accept" "(done_dialog)")(start_dialog)(unload_dialog d)(vl-file-delete f)))) ;;; copy to drawing (defun ctd ( ss dwg / ss->ol dbx_ver acApp acDoc dbx object-list object-safe-array) (defun SS->OL (ss / i l) (setq i 0)(repeat (sslength ss)(setq l (cons (vlax-ename->vla-object (ssname ss i)) l) i (1+ i))) l) (defun dbx_ver ( / v) (strcat "objectdbx.axdbdocument" (if (< (setq v (atoi (getvar 'acadver))) 16) "" (strcat "." (itoa v))))) (setq acApp (vlax-get-acad-object) acDoc (vla-get-ActiveDocument acApp)) (setq dbx (vl-catch-all-apply 'vla-getinterfaceobject (list acApp (dbx_ver)))) (vla-open dbx dwg) ; put all block objects in a list (setq object-list (ss->ol ss)) ; put list with objects in a safe array (setq object-safe-array (vlax-make-safearray vlax-vbobject (cons 0 (1- (length object-list))))) (vl-catch-all-apply 'vlax-safearray-fill (list object-safe-array object-list)) ; copy objects to dbx-drawing (vla-CopyObjects acDoc object-safe-array (vla-get-ModelSpace dbx)) (vl-catch-all-apply 'vla-saveas (list dbx dwg)) (vl-catch-all-apply 'vlax-release-object (list dbx)) (setq object-list nil object-safe-array nil) (princ) ) ; test : (setq lst (GetDocBlockNames (vla-get-ActiveDocument (vlax-get-acad-object)))) ; returns sorted list (uppercase) like : ("BLOCK_A" "BLOCK_B" ...) (defun GetDocBlockNames (d / o n l) (vlax-for o (vla-get-blocks d)(if (and (= :vlax-false (vla-get-isxref o))(= :vlax-false (vla-get-islayout o)) (snvalid (setq n (vla-get-name o)) 0))(setq l (cons (strcase n) l))))(if (vl-consp l)(acad_strlsort l))) (defun Get_DBX_Blocknames ( doc-name / lst v objectdbx-document) (cond ((not (eq (type doc-name) 'STR)) (princ (strcat "\nInvalid filename : " (vl-princ-to-string doc-name)))) ((not (findfile doc-name)) (princ (strcat "\nFile not found : " (vl-princ-to-string doc-name)))) (t (vlax-for doc (vla-get-Documents (vlax-get-acad-object)) (and (eq (strcase (vla-get-fullname doc)) (strcase doc-name))(setq objectdbx-document doc))) (cond ((eq (type objectdbx-document) 'VLA-OBJECT)) ((not (setq objectdbx-document (vlax-create-object (strcat "objectdbx.axdbdocument" (if (< (setq v (atoi (getvar 'acadver))) 16) "" (strcat "." (itoa v))))))) (princ "\nUnable to start object dbx")) ((vl-catch-all-error-p (vl-catch-all-apply 'vla-open (list objectdbx-document doc-name))) (princ (strcat "\nOdbx error - unable to acces : " doc-name))) (t (setq lst (GetDocBlockNames objectdbx-document))) ) ) ) (vl-catch-all-apply 'vla-close (list objectdbx-document :vlax-False)) (if (and (= 'vla-object (type objectdbx-document))(not (vlax-object-released-p objectdbx-document))) (vlax-release-object objectdbx-document)) (if (vl-consp lst) (mapcar 'strcase lst)) ) (c:cfld)

Hello, in the attached DWG drawing there was already a hatch, I drew a new one at the bottom, which should have the same properties, but I can't assign them. I tried with the brush, it doesn't work; with edit hatch I can't identify the exact scale of the original hatch, and if I try to change the scale of the new hatch, it disappears. I would like to ask how I could solve the problem. Thank you. Tratteggi.dwg

Could do it with pure LISP rather than reactors, a new name though ("CopyWithBlocks" and "PasteWithBlocks" or something like that. CwB, PwB) Weekend so CAD is off but something like this Copy: Select all the entities required in a selection set Select the basepoint (or use a nominal one if necessary) Loop through the selection set to find all the block names Save this list as a variable - or if you want to be really clever - add this list to the copied information (never tried that but I think it is possible), perhaps as xdata in a point or something that can later be found and deleted Copy to clipboard: (vl-cmdf "_.copyclip" basepoint MySS "") (vl-cmdf "_.copybase" basepoint MySS "") Paste: Find the list of blocks from the xdata, and create a list of blocks in the target drawing Compare the 2 lists and give any warnings necessary If OK, paste. If not OK don't paste.

Thank you very much, I also thought that the solution was to use Reactors... but creating a Lisp of this kind is way beyond my abilities! I hope that someone among the 'gurus' of this forum can help me. Thank you.

It would be nice to add a request along with the warning.: (setq choice (getkword "[Continue/caNcel/Rename/Add-index-1] <Rename>: "))

Sir, just I change date value 0 to 1, because dautm value and line is always varies. Program working perfectly for zero 0 datum value and line, if dautm value and line change, not getting accurate level , this attachment. Thanks DATUM VALUE CHANGE.dwg

Perhaps someone knows a better way. In my opinion, this could be done with reactors. That is, in your AutoCAD session, there should be two latent reactors: one that activates after "copyclip" is executed and looks for the most recent DWG in the "temp" folder and saves its name in a global variable; and another that activates just before "pasteclip" is executed (:vlr-commandWillStart) and tracks the blocks of the DWG where the "copyclip" was created and the blocks of the current drawing. There may already be a Lisp published in this forum that does this job, and some veteran can help you locate it.

Thanks for the assistance guys. I managed to get another version working after some trial and error (code below) @Lee Mac Yes, I had the variables defined but I just couldn't crack it with my limited LISP knowledge. Can I just add that I'm super thankful for all your work! Your LISP routines have had an immesurably beneficial impact on my workflow! If you have time, could you please take a look at this topic....it's the last LISP I need to 'complete' my LISP library! Thank you in advance if you can Polyline modification LISP - AutoLISP, Visual LISP & DCL - AutoCAD Forums Code that worked for me in the original post: (defun c:CLIENTDWG () (vl-load-com) (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object))) (setq fullpath (vla-get-FullName doc)) (if (and fullpath (/= fullpath "")) (progn (setq fname (vl-filename-base fullpath)) (setq fext (vl-filename-extension fullpath)) (setq fdir (vl-filename-directory fullpath)) (setq exportDir (strcat fdir "\\Exported Versions")) ;; Create EXPORTED folder if it doesn't exist (if (not (vl-file-directory-p exportDir)) (vl-mkdir exportDir) ) ;; Avoid duplicate suffix (if (wcmatch (strcase fname) "* - EXPORTED VERSION") (setq baseName fname) ; already has suffix (setq baseName (strcat fname " - EXPORTED VERSION")) ) ;; Construct new file path (setq newname (strcat exportDir "\\" baseName "." fext)) ;; Delete existing file if it exists (if (findfile newname) (vl-file-delete newname) ) ;; Save the drawing with the new name (vla-SaveAs doc newname) (princ (strcat "\nDrawing exported and saved as: " newname)) ) (princ "\nDrawing must be saved before exporting.") ) (princ) )

Hi all, Long story short, I waste tens of hours per year creating "quirks" in polylines, and I'm hoping that this could be automated using a LISP....problem is I have no idea where to start when it comes to manipulating geometry with LISP (or even if what I'm trying to achieve is possible). I'm wondering if anyone has a lisp, or could create a lisp (I will be eternally grateful) that can modify a polyline in a specific manner. The image below shows what I'm trying to achieve. I'd love to have 2 lisps. One to do corners (type 1 - calld "quirkc" ) and another to do lines (type 2 - called "quirkl"). The functionality I'd like to achieve in these LISPS is as follows; 1. Activate the lisp 2. Pick a point on the line or the corner (these geometries are polylines or closed polylines) 3. Have a prompt appear asking for width (x) and height (y) 4. modify the polyline as shown (create additional points in the polyline offset the required x and y distances) Thank you in advance for any help you can provide (or simply telling me this is not possible).

@Ish, if you don't mind, can you please attach video, gif, picture, etc. of the problem which you issued, because I'm not sure to fully understand the problem. Thanks

I made a stupid mistake and now I would like to find a way to avoid it: I copied a portion of a drawing (using CTRL+C) and pasted it into another (CTRL+V). The problem is that the copied part contained blocks that were already present with the same name in the new drawing. However, the blocks in the new drawing were slightly different. Is it possible to create a lisp or something that warns: 'Attention: the drawing already contains blocks named XXXX'?