Jump to content

Switching two items in a table in AutoCAD LISP


ryankevin15

Recommended Posts

  • Replies 23
  • Created
  • Last Reply

Top Posters In This Topic

  • rlx

    6

  • Grrr

    5

  • ryankevin15

    5

  • Tharwat

    4

Top Posters In This Topic

Previously I was about to ask if there was such functionality to shift table rows, but decided to code it myself rather than asking on the forums.

 

ShiftTableRow.gif

Link to comment
Share on other sites

Previously I was about to ask if there was such functionality to shift table rows, but decided to code it myself rather than asking on the forums.

 

ShiftTableRow.gif

 

Very nice Grrr, cool!

 

gr. Rlx

Link to comment
Share on other sites

@ryankevin15:

You should answer Lee's crucial question. If your table is not an actual table object Grrr's code won't work. Looking at your image I doubt it is a table object.

Link to comment
Share on other sites

No it's line objects in AutoCAD. Looks better/more control of style.

 

Try this:

(defun c:Test ( / one two no1 ob1 ls1 no2 ob2 ls2 sr1 sr2 nos a b en1 en2)
 ;;	Tharwat - Date:13.Jun.2017	;;
(if (and (princ "\nSelect texts in 1st row :")
     (setq one (ssget "_:L" '((0 . "*TEXT"))))
     (princ "\nSelect texts in 2nd row :")
     (setq two (ssget "_:L" '((0 . "*TEXT"))))
     )
 (progn
   (repeat (setq no1 (sslength one))
     (setq ob1 (ssname one (setq no1 (1- no1)))
           ls1 (cons (list (car (cdr (assoc 10 (entget ob1)))) ob1) ls1)
       )
     )
   (repeat (setq no2 (sslength two))
     (setq ob2 (ssname two (setq no2 (1- no2)))
           ls2 (cons (list (car (cdr (assoc 10 (entget ob2)))) ob2) ls2)
       )
     )
   (setq sr1 (vl-sort ls1 '(lambda (a b) (< (car a) (car b))))
         sr2 (vl-sort ls2 '(lambda (a b) (< (car a) (car b))))
         nos 0
     )
   (while (and (setq a (nth nos sr1))
               (setq en1 (entget (cadr a)))
               (setq b (nth nos sr2))
               (setq en2 (entget (cadr b)))
            )
     (entmod (subst (assoc 1 en1) (assoc 1 en2) en2))
     (entmod (subst (assoc 1 en2) (assoc 1 en1) en1))
     (setq nos (1+ nos))
     )
   )
 )
(princ))

Link to comment
Share on other sites

Wow! that works perfectly, could we get it where it'll work where you could have 2-3 lines trade with 2-3 lines? Maybe an error if the selections don't match in terms of the number of lines?

 

rrGjOMq.png

Link to comment
Share on other sites

Thank you. :)

 

 

 

 

I did make something simular for my VT text editor but its much bigger and not nearly as elegant as yours. But it can do multiple rows (or columns) and also attributes.

 

 

; based on VT.lsp by Rlx
(defun c:SwapTextRows ( / p1 p2 el1 el2 tl1 tl2)
 (if (and (setq el1 (sfs (setq p1 (getpoint "\nSelect 1st corner source row(s) : "))
    (setq p2 (getcorner p1 "\nOther corner : "))))
   (setq el2 (sfs (setq p1 (getpoint "\nSelect 1st corner target row(s) : "))
    (setq p2 (getcorner p1 "\nOther corner : ")))))
   (progn
     (setq el1 (SortElist el1) tl1 (mapcar '(lambda (x) (cdr (assoc 1 (entget x)))) el1)
    el2 (SortElist el2) tl2 (mapcar '(lambda (x) (cdr (assoc 1 (entget x)))) el2))
     (us el1 tl2)
     (us el2 tl1)
   )
 )
)

;remove duplicates
(defun rdup ( i / o ) (vl-remove-if '(lambda (x) (cond ((vl-position x o) t) ((setq o (cons x o)) nil))) i))


;get insertion point
(defun getip ( e / ent)
 (setq ent (vlax-ename->vla-object e))
 (if (= (vla-get-alignment ent) 0)
   (reverse (cdr (reverse (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint ent))))))
   (reverse (cdr (reverse (vlax-safearray->list (vlax-variant-value (vla-get-TextAlignmentPoint ent))))))))



;el = elist , xl = x , yl = y , ml = matrix , sl = sorted elist
(defun SortElist ( %elist / el xl yl ml sl)
 (if %elist
   (progn
     (setq el (mapcar '(lambda (x) (list (getip x) x)) %elist) ; %elist -> el ( ((ip)e1) ((ip)e2) .. )
    xl (vl-sort (rdup (mapcar 'caar el)) '<) yl (vl-sort (rdup (mapcar 'cadar el)) '>))
     (foreach y yl (foreach x xl (setq ml (append ml (list (list x y))))));sort by row
     (setq sl (vl-remove 'nil (mapcar '(lambda (x) (if (assoc x el)(cadr (assoc x el)))) ml))))))


; update string
(defun us (%el %sl)
 (mapcar '(lambda (e s / en)(setq en (entget e))(entmod (subst (cons 1 s) (assoc 1 en) en))) %el %sl))


; (point) inside window
(defun inside_w (ent p1 p2 / ip )
 (setq ip (getip ent))
 (if (and (>= (car ip)  (min (car p1)(car p2)))   (<= (car ip)  (max (car p1)(car p2)))
   (>= (cadr ip) (min (cadr p1)(cadr p2))) (<= (cadr ip) (max (cadr p1)(cadr p2)))) t nil))



;scan for string
(defun sfs ( %p1 %p2 / i ss el e et)
(if (setq i 0 ss (ssget "c" %p1 %p2))
  (while (setq e (ssname ss i))
   (setq et (cdr (assoc 0 (entget e))) i (1+ i))
   (cond ((member et '("TEXT" "MTEXT" "ATTRIB" "ATTDEF"))(setq el (cons e el)))
  ((= et "INSERT") (mapcar '(lambda (x) (if (inside_w x %p1 %p2)(setq el (cons x el))))(get-ents e)))))) el)


; get (block) entities
(defun get-ents ( b / obj e lst)
 ;attrib
 (setq obj (vlax-ename->vla-object b))
 (if (eq :vlax-true (vla-get-HasAttributes obj)) (setq lst (mapcar 'vlax-vla-object->ename (vlax-invoke obj 'GetAttributes))))
 ;text , disable if only attributes are needed
 (setq e (tblobjname "block" (vla-Get-EffectiveName obj)))
 (while (setq e (entnext e)) (if (member (cdr (assoc 0 (entget e))) (list "TEXT" "ATTDEF")) (setq lst (cons e lst)))) lst)
;-------


I try to be as elegant as a 'dragon' can be ... but sometimes ... when it works , it works :-)

 

 

gr. Rlx

Edited by rlx
Link to comment
Share on other sites

:thumbsup: Tharwat, you inspired me to play with this - grread version:

 

ExplodedTableShiftRows.gif

 

; Grrr - Exploded Table Shift Rows
; Credits to: Lee Mac, Tharwat
; 1. Select text/mtext that are representing cells from a exploded table
; 2. Use grread to shift their values
(defun C:test ( / SS->SortedMatrixL ShiftL L vL grr Stop )
 
 ; Map to the nth level items - Lee Mac :
 (defun mapncar ( n f l ) (if (< 0 n) (mapcar '(lambda ( x ) (mapncar (1- n) f x)) l) (mapcar f l) ) ) 
 
 ; (mysort (lambda (a b) (apply '< (mapcar 'car (list a b)))) pL)
 (defun mysort ( f L ) (mapcar (function (lambda (x) (nth x L))) (vl-sort-i L (function f))) )
 
 ;; Unique with Fuzz  -  Lee Mac
 ;; Returns a list with all elements considered duplicate to a given tolerance removed.
 (defun LM:UniqueFuzz ( l f / x r )
   (while l (setq x (car l) l (vl-remove-if (function (lambda ( y ) (equal x y f))) (cdr l)) r (cons x r) ) ) (reverse r)
 )
 
 (setq SS->SortedMatrixL
   (lambda ( fuzz / SS i o L tmpL rtn )  
     (cond
       ( (and (princ "\nSelect Text-Cells from Exploded Table to Shift: ") (setq SS (ssget "_:L-I" '((0 . "*TEXT")))))
         (repeat (setq i (sslength SS)) 
           (setq o (vlax-ename->vla-object (ssname SS (setq i (1- i)))))
           (setq L (cons (list (vlax-get o 'InsertionPoint) o) L))
         ); repeat 
         (foreach x (LM:UniqueFuzz (mapcar 'caar L) fuzz)
           (and 
             (setq tmpL (vl-remove-if-not (function (lambda (q) (equal x (caar q) fuzz))) L))
             (setq tmpL (mysort (lambda (a b) (apply '< (mapcar 'cadr (mapcar 'car (list a b))))) tmpL))
             (setq rtn (cons tmpL rtn))
           ); and
         ); foreach 
         (and rtn
           (setq rtn (vl-sort rtn (function (lambda (a b) (> (caaar a) (caaar b)))))) 
           (setq rtn (mapncar 1 '(lambda (x) (cadr x)) rtn))
         ); and
         rtn
       ); SS
     ); cond 
   ); lambda 
 ); setq SS->SortedMatrixL
 
 (setq ShiftL (lambda ( fl L ) (if (vl-consp L) (if fl (append (cdr L) (list (car L))) (append (list (last L)) (reverse (cdr (reverse L)))))))) 
 
 (cond 
   ( (not (setq L (SS->SortedMatrixL 1e-1))) (princ "\n Nothing Selected or Invalid Selection") ) ; '((o1 o2 o3) (o4 o5 o6) (o7 o8 o9))
   ( (not (and (vl-every 'vl-consp L) (apply '= (mapcar 'length L)))) (princ "\n Invalid Selection: Select equal amount of items per row.") )
   ( (princ "\nPress [W] or [s] to shift the Rows | [A] or [D] to shift the Columns <exit>: ")
     (setq vL (mapcar 'vla-get-TextString (apply 'append L))) ; values
     (while (not Stop) (setq grr (grread T)) 
       (and (or (equal grr '(2 13)) (member (car grr) '(3 25))) (setq Stop T)) ; Exit keys = ENTER or LMB/RMB
       (cond
         ( (and (= (car grr) 2) ) ; KBD
           (and
             (cond 
               ( (member (cadr grr) '(97 65)) (setq L (ShiftL T L)) )
               ( (member (cadr grr) '(100 68)) (setq L (ShiftL nil L)) )
               ( (member (cadr grr) '(119 87)) (setq L (mapcar (function (lambda (x) (ShiftL T x))) L)) )
               ( (member (cadr grr) '(115 83)) (setq L (mapcar (function (lambda (x) (ShiftL nil x))) L)) )
             ); cond
             (mapcar (function vla-put-TextString) (apply 'append L) vL)
           ); and 
         ); KBD
       ); cond			
     ); while
   )
 ); cond 
 (princ)
); defun C:test

 

Although I think that the simpliest way to "switch" both selections would be the way I mentioned in my previous post.

 

Not sure if posting the code of my previous demo will be a good idea, since I appreciate your programming work - and I don't feel like spreading freeware programs (although that was easy to assemble from a couple of subfunctions).

Link to comment
Share on other sites

Thank you guys for the positive feedback!

Hopefully you could benefit from that code. :)

 

 

I'm not sure if the smoke comming out of my brain when looking at your code is a benefit for me right now , but in time I hope to understand your code :book:

Link to comment
Share on other sites

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...