All Activity

@pkenewell Thanks for help. I downloaded the latest code from link and loaded it, but it doesn't seem to do anything. I probably don't understand how it works.

@NikonThanks for the code. I tried it. But it only works sometimes. And if the polylines' first point coincides with the last, it doesn't work. Is it possible that I'm doing something wrong?

pltools.lsp centerPline.LSP

Look into this post for ideas:

Yes you can use the plain ROTATE commad uing the reference option. For example, Command: ROTATE Current positive angle in UCS: ANGDIR=counterclockwise ANGBASE=0 Select objects: 1 found Select objects: pick object then enter Specify base point: vertex 1 Specify rotation angle or [Copy/Reference] <0>: r Specify the reference angle <0>: vertex 1 again Specify second point: vertex 2 Specify the new angle or [Points] <0>: vertex 3

Perhaps the most appropriate description is to obtain the axis between 2 irregular polylines

This?

You can also watch here: https://forums.augi.com/showthread.php?53180-Change-color-of-existing-MTEXT-Objects&highlight=remove formating

I'm no 3D expert, but should the OP be using the 2D Rotate if all they are doing is copying the Pyramid onto its side?

well , downloaded your files on my homedragon and no errors on my side , maybe others can give it a go and see if they get an error?

Posting a drawing would help to be more clear with what your asking for. but maybe this is what your looking for. PAV

Sometimes I find it much easier to use the ALIGN command instead of rotate or rotate3d. In this case just use d' and o' as the source points and points on the x axis for the two target points. The distance from the d' target point to the o' target point is not critical just don't scale the result when prompted.

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