ryankevin15 Posted June 9, 2017 Share Posted June 9, 2017 (edited) ..... Edited January 1, 2019 by ryankevin15 Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted June 9, 2017 Share Posted June 9, 2017 Are you using a table object or is the table composed of text & lines? Quote Link to comment Share on other sites More sharing options...
Grrr Posted June 9, 2017 Share Posted June 9, 2017 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. Quote Link to comment Share on other sites More sharing options...
rlx Posted June 9, 2017 Share Posted June 9, 2017 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. Very nice Grrr, cool! gr. Rlx Quote Link to comment Share on other sites More sharing options...
ryankevin15 Posted June 12, 2017 Author Share Posted June 12, 2017 could you share? Quote Link to comment Share on other sites More sharing options...
Roy_043 Posted June 12, 2017 Share Posted June 12, 2017 @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. Quote Link to comment Share on other sites More sharing options...
ryankevin15 Posted June 13, 2017 Author Share Posted June 13, 2017 No it's line objects in AutoCAD. Looks better/more control of style. Quote Link to comment Share on other sites More sharing options...
sieu khung khiep Posted June 13, 2017 Share Posted June 13, 2017 Nice Grrr Quote Link to comment Share on other sites More sharing options...
Tharwat Posted June 13, 2017 Share Posted June 13, 2017 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)) Quote Link to comment Share on other sites More sharing options...
ryankevin15 Posted June 13, 2017 Author Share Posted June 13, 2017 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? Quote Link to comment Share on other sites More sharing options...
Roy_043 Posted June 13, 2017 Share Posted June 13, 2017 You can quite easily perform this task manually with two move operations. Quote Link to comment Share on other sites More sharing options...
Grrr Posted June 13, 2017 Share Posted June 13, 2017 I'd just swap the two selection sets by their centroids. Quote Link to comment Share on other sites More sharing options...
rlx Posted June 14, 2017 Share Posted June 14, 2017 Try this:(defun c:Test ( / one two no1 ob1 ls1 no2 ob2 ls2 sr1 sr2 nos a b en1 en2) ;; Tharwat Beautiful! Quote Link to comment Share on other sites More sharing options...
Tharwat Posted June 14, 2017 Share Posted June 14, 2017 Beautiful! Thank you. Quote Link to comment Share on other sites More sharing options...
rlx Posted June 14, 2017 Share Posted June 14, 2017 (edited) 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 June 14, 2017 by rlx Quote Link to comment Share on other sites More sharing options...
Grrr Posted June 14, 2017 Share Posted June 14, 2017 Tharwat, you inspired me to play with this - grread version: ; 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). Quote Link to comment Share on other sites More sharing options...
Tharwat Posted June 14, 2017 Share Posted June 14, 2017 Tharwat, you inspired me to play with this - grread version: Cool. Nicely done. Quote Link to comment Share on other sites More sharing options...
rlx Posted June 15, 2017 Share Posted June 15, 2017 Tharwat, you inspired me to play with this Not sure if this is what requester wanted but brilliant nevertheless Quote Link to comment Share on other sites More sharing options...
Grrr Posted June 15, 2017 Share Posted June 15, 2017 Thank you guys for the positive feedback! Hopefully you could benefit from that code. Quote Link to comment Share on other sites More sharing options...
rlx Posted June 15, 2017 Share Posted June 15, 2017 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 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.