Swap objects

[itacad]

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

[rlx]

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

[BIGAL]

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

[rlx]

inspoint prop accoording to active-x reference

Edited April 11, 2021 by rlx

[itacad]

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

 

[devitg]

@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

[rlx]

i realy like the ,metxt, part

 

[BIGAL]

*TEXT 

[devitg]

My typo fault , .....

 

[itacad]

...Srry but I did not understand the suggestion of devitg...

 ...I tried to replace the line of code but it doesn't work ... regards

[devitg]

This line , if it is typed correctly, allow to select BLOCKREFERENCE  [INSERT], MTEXT,TEXT 

(setq ss (ssget "_:L" '((0 . "INSERT,MTEXT,TEXT"))))

 

 

[itacad]

Great! it works just how I need it!
Thanks so much!

[3dwannab]

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

 

[catoscuro]

swap  text

CopyText.lsp