Swapping rows or columns of the AutoCAD Table.

[AbdRF]

Hi all,
I am dealing with AutoCAD tables and want to know if there is any way we can swap two rows or columns with each other.
I have searched about this but was not able to find the solution.

Any help will be appreciated.

[BIGAL]

You can do it program wise, not sure manually, you may have to add a column copy a column to this new one copy and paste column back one, cut new column paste back in correct column, that did not make sense to me either when I wrote it.

 

columns A B C D

Add A B C D "E"

cut D paste E

Cut C Paste D

Cut E paste C

Delete E

 

[AbdRF]

@BIGAL

Thanks for replying. 
The manual process is too time-consuming, that's the main issue since I am dealing with different tables and as per requirement content should be in a certain order.
I am concern more about row swapping.
Can you guide me on how to do program wise, I only have very basic knowledge of LISP?

Thanks bro

 

[BIGAL]

In a simplistic form you read a table row by row and make a list of each row. ((a b c d e )(1 2 3 4 5)(A B C D E )) 3 rows 5 coulumns.

 

You can then do a VLA-put for a certain cell, you would say the "c" the 3rd item (nth 2 lst) no vla-put 2 1 the numbers are row and column grids positions.

 

Some example code

(setq numrows 2 numcolumns 3)
(setq rowheight 2.)
(setq colwidth 15.)
(setq objtable (vla-addtable curspc sp numrows numcolumns rowheight colwidth))
(vla-settext objtable 0 0 "Block Details")
(vla-settext objtable 1 0 "Block namei") 
(vla-settext objtable 1 1 "Detail 1")
(vla-settext objtable 1 2 "Detail 2")
(vla-settext objtable 1 3 "Total")

 

(vla-gettext objtable 1 3)

this would return "Total"

 

For better help post a dwg before table after table so can see where stuff is going.

 

Lee-mac has a pick cell in table would need something like that also in code, changing rows is harder than columns. Is it a sort of the table your looking for ?

 

 

Edited April 12, 2019 by BIGAL

[AbdRF]

@BIGAL

I am attaching the sample dwg for better understanding.
Thanks for your help, much appreciated.
sample_table_swap.dwg

[rlx]

(if I-re (member this correctly) :

 

 

 

[AbdRF]

@rlx

Thanks for posting.I tried your lisp but it is not working.
I am getting the following error:
 

Quote

Select 1st corner source row(s) :
Other corner : ; error: no function definition: SFS

Tables which with I am dealing contains mostly text and sometimes also object (Block in the Cell).
The basic requirement is two interchange entirely two rows.
I have attached the sample in the above reply.

Thanks for your help. 

[rlx]

can't open your drawing (here @work 2016 only I'm afraid) but 2nite maybe can have a look.

as for sfs (scan for string) I have a couple of versions so not sure this is the one but if you're talking about swapping rows in a real table , use Grrr's code

; scan for string %p1=cornerpoint1 , %p2=cornerpoint2 , %fl=flag (if T include block (m)text)
(defun sfs (%p1 %p2 %fl / _gip _pin _gbs ss i l e y )
  ; get insertionpoint e=ename
  (defun _gip (e) (if (assoc 11 (setq e (entget e)))(cdr (assoc 11 e))(cdr (assoc 10 e))))
  ; point inside a=point , b=cornerpoint1 , c=cornerpoint2
  (defun _pin (a b c) (if (and (>= (car a)(min (car b)(car c)))(<= (car a)(max (car b)(car c)))
    (>= (cadr a) (min (cadr b)(cadr c)))(<= (cadr a) (max (cadr b)(cadr c)))) t nil))
  ; get block string a = block (ename) , f=include (m)text , c=etype , r=result
  (defun _gbs (a f / c d r)
    (while (and (setq a (entnext a))(setq c (cdr (assoc 0 (entget a)))))
      (cond ((not (member c '("ATTRIB" "TEXT" "MTEXT")))) ((not (_pin (_gip a) %p1 %p2)))
     (t (if (= c "ATTRIB")(setq r (cons a r)) (if (and f (member c '("TEXT" "MTEXT")))(setq r (cons a r))))))) r)
  ; main routine
  (if (setq ss (ssget "c" %p1 %p2))
    (repeat (setq i (sslength ss)) (setq y (cdr (assoc 0 (entget (setq e (ssname ss (setq i (1- i))))))))
      (cond ((member y '("TEXT" "MTEXT" "ATTDEF"))(setq l (cons e l)))
     ((eq y "INSERT")(setq l (append l (_gbs e %fl)))))))
  l
)


; get all block strings, blk = block ent (ename) , fl = flag (if T also include (M)text entities
; returns : list with enames
; test : (setq lst (gabs (car (entsel))))
(defun gabs (blk fl / bn lst enum etyp)
  ;;; block check
  (cond ((null blk))((not (eq (type blk) 'ENAME)))((not (eq (cdr (assoc 0 (entget blk))) "INSERT")))
 (t (setq bn (cdr (assoc 2 (entget blk))))))
  ;;; attribute check
  (if (and bn (= (cdr (assoc 66 (entget blk))) 1))
    (progn
      (setq enum (entnext blk) etyp (cdr (assoc 0 (entget enum))))
      (while (not (= etyp "SEQEND"))
 (if (and (= etyp "ATTRIB")(inside_w enum %p1 %p2))
   (setq lst (append lst (list enum))))
 (setq enum (entnext enum) etyp (cdr (assoc 0 (entget enum)))))))
  ;;; texten check
  (if (and bn fl (setq enum (tblobjname "block" bn)))
    (while (setq enum (entnext enum))
      (if (member (cdr (assoc 0 (entget enum))) '("TEXT" "MTEXT"))
        (setq lst (append lst (list enum ))))))
  lst)

 

(defun c:t1 ()(vl-load-com)
  (princ "\nScan for string , block (m)text's NOT included")
  (if (and (setq p1 (getpoint "\nSelect first corner :")) (setq p2 (getcorner p1 "\nSelect second corner :")))(sfs p1 p2 nil))
)


(defun c:t2 ()
  (princ "\nScan for string , block (m)text's WILL BE included")
  (if (and (setq p1 (getpoint "\nSelect first corner :")) (setq p2 (getcorner p1 "\nSelect second corner :")))(sfs p1 p2 T)))

(defun c:t3 ()(vl-load-com)
  (princ "\nScan for string , block (m)text's NOT included")
  (if (and (setq p1 (getpoint "\nSelect first corner :")) (setq p2 (getcorner p1 "\nSelect second corner :")))
    (mapcar
      '(lambda (x)
  (if (vlax-property-available-p x 'tagstring)(princ (strcat "\nTagstring = " (vla-get-tagstring x))))
  (if (vlax-property-available-p x 'textstring)(princ (strcat "\nTextstring = " (vla-get-textstring x)))))
       (mapcar 'vlax-ename->vla-object (sfs p1 p2 nil))
    )
  )
  (princ)
)

(defun c:t4 ()(vl-load-com)
  (princ "\nScan for string , block (m)text's WILL BE included")
  (if (and (setq p1 (getpoint "\nSelect first corner :")) (setq p2 (getcorner p1 "\nSelect second corner :")))
    (mapcar
      '(lambda (x)
  (if (vlax-property-available-p x 'tagstring)(princ (strcat "\nTagstring = " (vla-get-tagstring x))))
  (if (vlax-property-available-p x 'textstring)(princ (strcat "\nTextstring = " (vla-get-textstring x)))))
       (mapcar 'vlax-ename->vla-object (sfs p1 p2 T))
    )
  )
  (princ)
)

 

[AbdRF]

@rlx

FYI I am using this one posted by you .
 

Quote

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

 

[rlx]

well I see (defun sfs..  is included so that shouldn't be the problem , function probably doesn't work for your drawing / table , can't tell from here

[rlx]

understand I can sorting first column you want but why PQ.. , XY... AB and not just AB..,PQ..,XY..?

[rlx]

(vl-load-com)

(defun c:AbdRf ( / tbl lst s slt i idx l)
  (if (setq tbl (ssget "_+.:E:S" '((0 . "ACAD_TABLE"))))
    (progn
      (setq lst (cddr (ttl (setq tbl (vlax-ename->vla-object (ssname tbl 0)))))
            slt (vl-sort lst '(lambda (x y) (< (car x) (car y))))
            idx (rdup (mapcar '(lambda (x)(substr (car x) 1 2)) lst)))
      (foreach i idx
        (foreach s slt
          (if (eq i (substr (car s) 1 2)) (setq l (cons s l) slt (rfl s slt)))))
      (ltt tbl (reverse l))
    )
  )
  (princ)
)


;;; remove duplicates
(defun rdup (l / o)(vl-remove-if '(lambda (x) (cond ((vl-position x o) t) ((setq o (cons x o)) nil))) l))
;;; remove from list
(defun rfl (e l)(apply 'append (subst nil (list e) (mapcar 'list l))))
;;; table to list
(defun ttl ( o / c l r v )
  (repeat (setq r (vla-get-rows o)) (repeat (setq r (1- r) c (vla-get-columns o))
    (setq v (cons (vlax-invoke o 'getcellvalue r (setq c (1- c))) v))) (setq l (cons v l) v nil)) l)
;;; list to table
(defun ltt (o l / r s c x)
  (setq r 2)(vla-put-regeneratetablesuppressed o :vlax-true)
   (foreach s l (setq c 0)(foreach x s (vla-setcellvalue o r c x)(setq c (1+ c)))(setq r (1+ r)))
    (vla-put-regeneratetablesuppressed o :vlax-false))

[BIGAL]

This is pretty coo lhttps://jtbworld.com/jtb-sort-table $10 US.

 

If your doing a lot worthwhile.

[AbdRF]

@rlx @BIGAL

Thanks for your effort and time.
Much appreciated