Jump to content
AbdRF

Swapping rows or columns of the AutoCAD Table.

Recommended Posts

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.

Share this post


Link to post
Share on other sites
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

 

Share this post


Link to post
Share on other sites
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

 

Share this post


Link to post
Share on other sites
BIGAL
Posted (edited)

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 by BIGAL

Share this post


Link to post
Share on other sites
rlx

(if I-re (member this correctly) :

 

 

 

Share this post


Link to post
Share on other sites
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. 

Share this post


Link to post
Share on other sites
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)
)

 

Share this post


Link to post
Share on other sites
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)
;-------

 

Share this post


Link to post
Share on other sites
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

Share this post


Link to post
Share on other sites
rlx

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

Share this post


Link to post
Share on other sites
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))

Share this post


Link to post
Share on other sites
AbdRF

@rlx @BIGAL

Thanks for your effort and time.
Much appreciated 😀

Share this post


Link to post
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
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

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