All Activity

Do you need to rotate the pyramid itself, or just the view of it? You can draw it once in model space, then create multiple viewports in paper space to get the diagram you attached. No need to rotate the original pyramid.

Hi again. This may also happen to others: sometimes I have two polylines and I need to get something like a common parallel to both. A sort of hybrid parallel from the original two. Is it possible that this topic has been discussed in the history of this forum and there is a LISP to solve this problem? Thanks in advance.

Try this code, calling with command: MtextToByLayerNoNum (defun _strip-mtext-color (s / i j) ;; Deletes all occurrences \C<number>; and \c<number>; (setq i 0) (while (setq i (vl-string-search "\\C" s i)) (if (setq j (vl-string-search ";" s i)) (setq s (strcat (substr s 1 i) (substr s (+ j 2))) i i) (setq s (substr s 1 i)) ) ) (setq i 0) (while (setq i (vl-string-search "\\c" s i)) (if (setq j (vl-string-search ";" s i)) (setq s (strcat (substr s 1 i) (substr s (+ j 2))) i i) (setq s (substr s 1 i)) ) ) s ) (defun c:MtextToByLayerNoNum (/ 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 (_strip-mtext-color newtext)) (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) )

@Ajmal Thank you this is equally amazing! I now have two versions that cover all scenarios. I can use @Tsuky's version when the quirk dimensions are equal as this version doesnt require as much user input. Then, for the more unusual quirks I can switch to your version and specify the parameters. Thanks guys problem solved! I'm sure I'll come up with a new problem soon

@Tsuky Thank you so much this is absolutley amazing! It doesn't allow the width and height to be specified independantly, but considering that the vast mojority of the time these are the same it's really no issue at all to just adjust them when required. Again, thank you

Another thread... LISP to Remove Unreferenced Xref - AutoLISP, Visual LISP & DCL - AutoCAD Forums I use this, I am pretty sure it does what you want and much more. RadicalPurge | AutoCAD | Autodesk App Store

You need to select a polyline near a corner. After providing the width (X) and depth (Y) dimensions, it automatically modifies the polyline by replacing the selected corner vertex with three new vertices to form the specified quirk. ;;; QUIRKC.LSP - Creates a "Quirk" at the corner of a LWPOLYLINE ;;;------------------------------------------------------------------; (defun c:QUIRKC (/ *error* doc obj sel pt coords len i min-dist dist idx pt-c pt-p pt-n ang1 ang2 x y new-p1 new-p2 new-p3 new-coords-flat) (defun *error* (msg) (if (and doc (not (vlax-object-released-p doc))) (vla-endundomark doc) ) (if (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*")) (princ (strcat "\nError: " msg)) ) (princ) ) (vl-load-com) (setq doc (vla-get-activedocument (vlax-get-acad-object))) (vla-startundomark doc) (princ "\nSelect a polyline near the corner to modify: ") (setq sel (entsel)) (if (and sel (eq (cdr (assoc 0 (entget (car sel)))) "LWPOLYLINE")) (progn (setq obj (vlax-ename->vla-object (car sel))) (setq pt (trans (cadr sel) 1 0)) ; Clicked point in WCS (setq coords (vlax-get obj 'Coordinates)) (setq len (length coords)) ;; Find the closest vertex to the clicked point (setq i 0 min-dist -1 idx -1) (while (< i len) (setq current-pt (list (nth i coords) (nth (1+ i) coords))) (setq dist (distance pt current-pt)) (if (or (< min-dist 0) (< dist min-dist)) (setq min-dist dist idx (/ i 2)) ) (setq i (+ i 2)) ) ;; Get corner, previous, and next vertices (setq pt-c (list (nth (* idx 2) coords) (nth (1+ (* idx 2)) coords))) (if (eq idx 0) (if (vlax-curve-isclosed obj) (setq pt-p (list (nth (- len 2) coords) (nth (1- len) coords))) (setq pt-p nil) ) (setq pt-p (list (nth (* (1- idx) 2) coords) (nth (1+ (* (1- idx) 2)) coords))) ) (if (eq idx (/ (- len 2) 2)) (if (vlax-curve-isclosed obj) (setq pt-n (list (nth 0 coords) (nth 1 coords))) (setq pt-n nil) ) (setq pt-n (list (nth (* (1+ idx) 2) coords) (nth (1+ (* (1+ idx) 2)) coords))) ) (if (and pt-p pt-n) (progn ;; Get user input for X and Y dimensions (setq x (getdist "\nEnter Width (X) of quirk: ")) (setq y (getdist pt-c "\nEnter Depth (Y) of quirk: ")) (if (and x y (> x 0) (> y 0)) (progn ;; Calculate the new points for the quirk (setq ang1 (angle pt-c pt-p)) (setq ang2 (angle pt-c pt-n)) (setq new-p1 (polar pt-c ang1 y)) (setq new-p2 (polar new-p1 ang2 x)) (setq new-p3 (polar pt-c ang2 x)) ;; Rebuild the coordinate list (setq i 0 new-coords-flat '()) (while (< i len) (if (eq (/ i 2) idx) (setq new-coords-flat (append new-coords-flat (list (car new-p1) (cadr new-p1) (car new-p2) (cadr new-p2) (car new-p3) (cadr new-p3)))) (setq new-coords-flat (append new-coords-flat (list (nth i coords) (nth (1+ i) coords)))) ) (setq i (+ i 2)) ) ;; Update the polyline with the new coordinates (vla-put-coordinates obj (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble (cons 0 (1- (length new-coords-flat)))) new-coords-flat ) ) ) ) (princ "\nInvalid input. X and Y must be greater than zero.") ) ) (princ "\nCorner must not be an endpoint of an open polyline.") ) ) (princ "\nNo valid LWPOLYLINE was selected.") ) (vla-endundomark doc) (princ) ) You first select a point on a polyline segment and click to choose which side the quirk should be on. After providing the width (X) and length (Y), the script automatically adds the four new vertices to create the specified quirk, perfectly centered on your initial selection point. ;;; QUIRKL.LSP (Final Version with Direction Control) ;;; Creates a "Quirk" on a user-specified side of a LWPOLYLINE segment. ;;;---------------------------------------------------------------------; (defun c:QUIRKL (/ *error* doc sel obj pt click-pt side-pt param idx pt1 pt2 ang-along ang-perp ang-perp1 ang-perp2 test-p1 test-p2 x y p1 p2 p3 p4 coords new-coords-flat i) (defun *error* (msg) (if (and doc (not (vlax-object-released-p doc))) (vla-endundomark doc) ) (if (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*")) (princ (strcat "\nError: " msg)) ) (princ) ) (vl-load-com) (setq doc (vla-get-activedocument (vlax-get-acad-object))) (vla-startundomark doc) (princ "\nSelect a point on the polyline segment to modify: ") (setq sel (entsel)) (if (and sel (eq (cdr (assoc 0 (entget (car sel)))) "LWPOLYLINE")) (progn (setq obj (vlax-ename->vla-object (car sel))) (setq click-pt (trans (cadr sel) 1 0)) (setq pt (vlax-curve-getclosestpointto obj click-pt)) ;; -- FEATURE: ASK USER FOR THE SIDE -- (setq side-pt (getpoint pt "\nClick on the side for the quirk: ")) (if side-pt (progn (setq x (getdist pt "\nEnter Width (X) of quirk: ")) (setq y (getdist pt "\nEnter Length (Y) of quirk: ")) (if (and x y (> x 0) (> y 0)) (progn (setq param (vlax-curve-getparamatpoint obj pt)) (setq idx (fix param)) (setq pt1 (vlax-curve-getpointatparam obj idx)) (setq pt2 (vlax-curve-getpointatparam obj (1+ idx))) (setq ang-along (angle pt1 pt2)) ;; -- Determine the correct perpendicular angle based on user's click -- (setq ang-perp1 (+ ang-along (/ pi 2.0))) ; Option 1 (CCW) (setq ang-perp2 (- ang-along (/ pi 2.0))) ; Option 2 (CW) (setq test-p1 (polar pt ang-perp1 1.0)) (setq test-p2 (polar pt ang-perp2 1.0)) (if (< (distance side-pt test-p1) (distance side-pt test-p2)) (setq ang-perp ang-perp1) (setq ang-perp ang-perp2) ) ;; Calculate new points using the chosen angle (setq p1 (polar pt ang-along (- (/ y 2.0)))) (setq p2 (polar p1 ang-perp x)) (setq p3 (polar p2 ang-along y)) (setq p4 (polar p3 (+ ang-perp pi) x)) ;; Rebuild the coordinate list (setq coords (vlax-get obj 'Coordinates)) (setq i 0 new-coords-flat '()) (while (< i (length coords)) (setq new-coords-flat (append new-coords-flat (list (nth i coords) (nth (1+ i) coords)))) (if (eq (/ i 2) idx) (setq new-coords-flat (append new-coords-flat (list (car p1) (cadr p1) (car p2) (cadr p2) (car p3) (cadr p3) (car p4) (cadr p4)))) ) (setq i (+ i 2)) ) ;; Update the polyline (vla-put-coordinates obj (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble (cons 0 (1- (length new-coords-flat)))) new-coords-flat ) ) ) ) (princ "\nInvalid input. X and Y must be greater than zero.") ) ) ) ) (princ "\nNo valid LWPOLYLINE was selected.") ) (vla-endundomark doc) (princ) )

Please use Code Tags for your code in the future. (<> in the editor toolbar)

... Don't worry: take it slow. Even my home PC went crazy yesterday: the screen was filled with colored squares and everything froze! These PCs are unpredictable... like a woman! Maybe that's their charm!

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

wow this works thank u so much

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