itacad Posted April 10, 2021 Share Posted April 10, 2021 Hi, I think I found the lisp that I am attaching on this forum. It is a very useful lisp, it allows you to move two blocks between them, swapping their positions, using the insertion point of both. Unfortunately it has the limitation that it only works with blocks. Could it be correct to swap the position of all objects that have an insertion point? thank you very much SWAP.LSP 1 Quote Link to comment Share on other sites More sharing options...
rlx Posted April 10, 2021 Share Posted April 10, 2021 UU (utterly untested) (defun c:swap ( / ss l) (vl-load-com) (princ "\nSelect 2 objects with insertionpoint : ") (cond ((not (setq ss (ssget "_:L")))(alert "Selection cancelled")) ((not (= 2 (sslength ss))) (alert (strcat "You selected " (sslength ss) " objects"))) ((not (vl-every 'vl-consp (setq l (mapcar '(lambda (i)(getip (vlax-ename->vla-object (ssname ss i)))) '(0 1))))) (alert "Insertionpoint error")) (t (putip (cadar l) (caadr l)) (putip (cadadr l) (caar l))))(princ)) (defun getip (o) (cond ((vlax-property-available-p o 'TextAlignmentPoint) (if (= (vla-get-alignment o) 0)(list (vla-get-InsertionPoint o) o)(list (vla-get-TextAlignmentPoint o) o))) ((vlax-property-available-p o 'InsertionPoint)(list (vla-get-InsertionPoint o) o)))) (defun putip (o p) (if (and (vlax-property-available-p o 'TextAlignmentPoint)(/= (vla-get-alignment o) 0)) (progn (vla-put-insertionpoint o p)(vla-put-TextAlignmentpoint o p))(vla-put-insertionpoint o p))) Quote Link to comment Share on other sites More sharing options...
BIGAL Posted April 10, 2021 Share Posted April 10, 2021 (edited) Not sure how many objects have a Insertion point may be better as a series of defuns could swap a line and a block. Just thinking Block Insertion point *Text has as suggested alignment point Arc & Circle centre point Line start pt, mid , end Pline 1st vertice or (GC) hatch has a pt Need Itacad to narrow down what is to be swapped and the rules. Edited April 10, 2021 by BIGAL Quote Link to comment Share on other sites More sharing options...
rlx Posted April 11, 2021 Share Posted April 11, 2021 (edited) inspoint prop accoording to active-x reference Edited April 11, 2021 by rlx Quote Link to comment Share on other sites More sharing options...
itacad Posted April 11, 2021 Author Share Posted April 11, 2021 Hello and thanks in the meantime. By insertion point I meant what is considered such by the object snap. For example, texts have an insertion point...for other types of objects (lines, polygons, etc.) I don't need them. Greetings Quote Link to comment Share on other sites More sharing options...
devitg Posted April 13, 2021 Share Posted April 13, 2021 (edited) @itacad, maybe some like it (setq ss (ssget "_:L" '((0 . "INSERT,metxt,text")))) Maybe you will need to check if selection hold same entities kind , Edited April 13, 2021 by devitg Quote Link to comment Share on other sites More sharing options...
rlx Posted April 13, 2021 Share Posted April 13, 2021 i realy like the ,metxt, part 1 Quote Link to comment Share on other sites More sharing options...
BIGAL Posted April 13, 2021 Share Posted April 13, 2021 *TEXT Quote Link to comment Share on other sites More sharing options...
devitg Posted April 14, 2021 Share Posted April 14, 2021 My typo fault , ..... Quote Link to comment Share on other sites More sharing options...
itacad Posted April 15, 2021 Author Share Posted April 15, 2021 ...Srry but I did not understand the suggestion of devitg... ...I tried to replace the line of code but it doesn't work ... regards Quote Link to comment Share on other sites More sharing options...
devitg Posted April 15, 2021 Share Posted April 15, 2021 This line , if it is typed correctly, allow to select BLOCKREFERENCE [INSERT], MTEXT,TEXT (setq ss (ssget "_:L" '((0 . "INSERT,MTEXT,TEXT")))) Quote Link to comment Share on other sites More sharing options...
itacad Posted April 17, 2021 Author Share Posted April 17, 2021 Great! it works just how I need it! Thanks so much! 1 Quote Link to comment Share on other sites More sharing options...
3dwannab Posted May 27 Share Posted May 27 My go at it. Mod of something I found before. I usually document that in my scripts ;; SWO - Swap with objects ;; 2023.07.10 - 3dwannab edit - Added better undo handling if escape has been pressed before the 2nd selection set. ;; 2024.04.16 - 3dwannab edit - Added option to delete either the first or second selection and a none option also. ;; 2024.05.27 - 3dwannab edit - Added selection of objects after the swap. ;============================================================================== (defun c:SWO (/ *error* _addss acDoc ans el1 el2 rp1 rp2 ss1 ss1_ss2 ss2 tp1 tp2 var_cmdecho) (defun *error* (errmsg) (and acDoc (vla-EndUndoMark acDoc)) (and errmsg (not (wcmatch (strcase errmsg) "*CANCEL*,*EXIT*")) (princ (strcat "\n<< Error: " errmsg " >>\n")) ) (setvar 'cmdecho var_cmdecho) ) ; Combine selection sets (defun _addss (a b / i) (setq i -1) (repeat (sslength a) (ssadd (ssname a (setq i (1+ i))) b) ) b ) (setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object))) (or (vla-EndUndoMark acDoc) (vla-StartUndoMark acDoc)) (setq var_cmdecho (getvar "cmdecho")) (setq var_osmode (getvar "osmode")) (setvar 'cmdecho 0) (setq pmpt "\nPick a reference point") (prompt "\nFirst selection set...") (setq ss1 (ssget "_:L")) (if (= ss1 nil) (progn (alert "Error 060:\nNothing selected") (quit))) (if (> (sslength ss1) 1) (setq rp1 (getpoint (strcat pmpt ": "))) (progn (setq el1 (entget (ssname ss1 0))) (setq tp1 (cdr (assoc 0 el1))) (if (or (= tp1 "ATTDEF") (= tp1 "ARC") (= tp1 "CIRCLE") (= tp1 "INSERT") (= tp1 "SHAPE") (= tp1 "TEXT") ) (progn (setq rp1 (getpoint (strcat pmpt ", or <RETURN> for element's insertion point: "))) (if (or (= rp1 nil) (= rp1 "")) (setq rp1 (strcat (rtos (cadr (assoc 10 el1))) "," (rtos (caddr (assoc 10 el1))))) ) ) (setq rp1 (getpoint (strcat pmpt ": "))) ) ) ) (prompt "\nSecond selection set...") (setq ss2 (ssget)) (if (= ss2 nil) (progn (alert "Error:\nNothing selected") (quit))) (if (> (sslength ss2) 1) (setq rp2 (getpoint (strcat pmpt ": "))) (progn (setq el2 (entget (ssname ss2 0))) (setq tp2 (cdr (assoc 0 el2))) (if (or (= tp2 "ATTDEF") (= tp2 "ARC") (= tp2 "CIRCLE") (= tp2 "INSERT") (= tp2 "SHAPE") (= tp2 "TEXT") ) (progn (setq rp2 (getpoint (strcat pmpt ", or <RETURN> for element's insertion point: "))) (if (or (= rp2 nil) (= rp2 "")) (setq rp2 (strcat (rtos (cadr (assoc 10 el2))) "," (rtos (caddr (assoc 10 el2))))) ) ) (setq rp2 (getpoint (strcat pmpt ": "))) ) ) ) (command "._move" ss1 "" rp1 rp2) (command "._move" ss2 "" rp2 rp1) (if (and ss1 ss2) (progn ;; initget from LeeMac help pages (initget "First Second None") (setq ans (cond ((getkword (strcat "\nWhich selection do you want to delete? [First/Second/None] <" (setq ans (cond (ans) ("First"))) ">: " ) ) ) (ans) ) ) (cond ((= "First" ans) (progn (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss1))) (entdel e) ) (princ (strcat "\n: ------------------------------\n\t\t<<< " (itoa (sslength ss2)) (if (> (sslength ss2) 1) " <<< swapped objects" " <<< swapped object") " selected | First selection set deleted.\n: ------------------------------\n")) (sssetfirst nil ss2) (command "_.regen") ) ) ((= "Second" ans) (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss2))) (entdel e) ) (princ (strcat "\n: ------------------------------\n\t\t<<< " (itoa (sslength ss1)) (if (> (sslength ss1) 1) " <<< swapped objects" " <<< swapped object") " selected | Second selection set deleted.\n: ------------------------------\n")) (sssetfirst nil ss1) (command "_.regen") ) ((= "None" ans) (progn (setq ss1_ss2 (_addss ss1 ss2)) (princ (strcat "\n: ------------------------------\n\t\t<<< " (itoa (sslength ss1_ss2)) " <<< swapped objects selected | No selection sets deleted.\n: ------------------------------\n")) (sssetfirst nil ss1_ss2) (command "_.regen") ) ) ) ) ) (redraw) (*error* nil) (princ) ) Quote Link to comment Share on other sites More sharing options...
catoscuro Posted May 30 Share Posted May 30 swap text CopyText.lsp Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.