All Activity

I found a lisp to adjust mtext color to bycolor but it shows the color code after adjusting. Please help me to adjust it and only remove the code before the text! Thank you. I want it like this mtext : room (color cycan) to room (bylayer) lisp : room(color cycan) to 4:room (bylayer( (defun c:MtextToByLayer (/ ss ent elist newtext) (princ "\nSelect Mtext objects to set to ByLayer.") (if (setq ss (ssget '((0 . "MTEXT")))) ; Select only MTEXT entities (progn (vlax-for ent (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object))) (if (= (vla-get-ObjectName ent) "AcDbMText") (progn ; Set the entity color to ByLayer (color code 256) (vla-put-color ent 256) ; Get the Mtext content (setq elist (entget (vlax-vla-object->ename ent))) (setq newtext (cdr (assoc 1 elist))) ; Strip all internal formatting codes, including color (setq newtext (vl-string-subst "" "{\\C" newtext)) ; Removes color codes (setq newtext (vl-string-subst "" "\\c" newtext)) ; Removes inline color codes (while (vl-string-search "{" newtext) (setq newtext (vl-string-subst "" "{" newtext)) (setq newtext (vl-string-subst "" "}" newtext)) ) ; Update the Mtext entity with the stripped text (vla-put-TextString ent newtext) ) ) ) (princ (strcat "\n" (itoa (sslength ss)) " Mtext objects updated.")) ) (princ "\nNo Mtext objects selected.") ) (princ) )

these days I also can't copy / paste / download on my worklaptop but will have a look tonight. Maybe make sure the drawing you copy to is closed. I only tested it once on my home laptop and had nos problemos you knowos... and maybe look for locked layers? Just hope I can still post...

Depending on your version of CAD, you can use this: (defun c:test ( ) (command "_.-insert" "yourblockname" "_s" 1 "_r" 0 "_re" "_y") (while (= 1 (logand 1 (getvar 'cmdactive))) (command "\\")) (princ) )

You can try this. I think is good for you. notch.lsp

DWG1.dwg DWG2.dwg

Maybe this (defun c:guardAA (/ v nvoD f? v lv c n para substCad) (defun substCad (tx a n / c i r) (while (/= (setq c (substr tx (setq i (if i (1+ i) 1)) 1)) "") (setq r (strcat (if r r "") (if (= c a) n c)))) ) (vl-catch-all-apply '(lambda () (while (not para) (initget 1 (strcat (foreach v (list "R14" "2000" "2004" "2007" "2010" "2013" "2018") (setq c (strcat (if c c "") (if (and (not (assoc v lv)) (eval (read (strcat "ac" v "_dwg")))) (strcat v " ") "")))) "Continue")) (setq v (getkword (strcat "\rSelect versions [" (substCad (strcat c "Continue") " " "/") "]: "))) (if (= v "Continue") (setq para T) (setq lv (append lv (list (list v (eval (read (strcat "ac" v "_dwg")))))) c nil)) ) (setq f? (if (not (vl-directory-files (setq nvoD (strcat (getvar "DWGPREFIX") "EXPORTED\\")))) (VL-MKDIR nvoD) T)) (foreach v lv (vla-saveas (vla-get-activedocument (vlax-get-acad-object)) (strcat (if f? nvoD (getvar "DWGPREFIX")) (VL-FILENAME-BASE (setq n (if n n (getvar "DWGNAME")))) "_v" (car v) ".dwg") (cadr v)) ) (princ (if lv "\nDone!" "\nNothing to do")) ) ) (princ) ) PS: Untested

For even a pline or a line you can click near an end so setting direction, then you would enter offset, length and height. A little more accurate than pick a point on the object. Added to my "To do list" if @devitg does not do something 1st. Can use a dcl for input.

@swanny89 I guess both values W H could be different ?

What would need to be changed in this code to save multiple DWG versions at once?

@devitg Thank you for taking the time to look into this for me! Attached is a copy of the dwg with the basic geometry (before and after). I'd say in 90% of cases the rectangles would be orthogonal like you say, but sometimes they can be at any angle. If we could capture the 90% use case that would be hugely beneficial on it's own. Quirk.dwg

If it is just a stand alone action, this will work but you have to escape out of it to cancel - you cannot have more to the routine, so stand alone only (while (= (command "-INSERT" GV-Block pause "" "" "0") nil) ) or this (while (setq pt1 (getpoint "Press LH Mouse to repeat, Enter / Space cancel")) (= (command "-insert" "circuitBreaker" pause 1 1 0) nil) )

@swanny89 Please upload your.dwg sample. Would be all polylines rectangles orthogonal to X and Y axis?

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