Author Topic: Highlighting Every Other Row of Table  (Read 5297 times)

0 Members and 1 Guest are viewing this topic.

cmwade77

  • Swamp Rat
  • Posts: 1443
Highlighting Every Other Row of Table
« on: July 10, 2018, 08:00:12 PM »
Lee has a great routine for doing this at: https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/lisp-for-alternating-background-fill-in-table/m-p/4476927/highlight/true#M315439

The only problem with it is that it is very slow on larger tables (about 5 columns with 90 some odd rows took around 5 minutes), I am wondering if anyone here or perhaps Lee could help with speeding up the code. Admittedly, I haven't had the time to take too deep of a dive into yet myslef, but really this was a life saver for what I needed to do, I just would like it to be faster.

Code: [Select]
;; Alternating Table Background Colour  -  Lee Mac

(defun c:altback ( / *error* acc col fnc idx obj row sel tmp )

    (defun *error* ( msg )
        (if (and (= 'vla-object (type acc)) (not (vlax-object-released-p acc)))
            (vlax-release-object acc)
        )
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )

    (setq col '(215 215 215)) ;; True Colour (r g b) for cell background
   
    (if (setq sel (ssget "_:L" '((0 . "ACAD_TABLE"))))
        (if (setq acc (vla-getinterfaceobject (vlax-get-acad-object) (strcat "autocad.accmcolor." (substr (getvar 'acadver) 1 2))))
            (progn
                (apply 'vla-setrgb (cons acc col))
                (repeat (setq idx (sslength sel))
                    (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx))))
                          col (vla-get-columns obj)
                    )
                    (repeat (setq row (vla-get-rows obj))
                        (if (zerop (rem (setq row (1- row)) 2))
                            (setq fnc (lambda ( a b ) (vla-setcellbackgroundcolor obj a b acc)))
                            (setq fnc (lambda ( a b ) (vla-setcellbackgroundcolornone obj a b :vlax-true)))
                        )
                        (repeat (setq tmp col) (fnc row (setq tmp (1- tmp))))
                    )
                )
                (vlax-release-object acc)
            )
            (princ "\nUnable to interface with AcCmColor object.")
        )
    )
    (princ)
)
(vl-load-com) (princ)


Lee Mac

  • Seagull
  • Posts: 12905
  • London, England
Re: Highlighting Every Other Row of Table
« Reply #2 on: July 11, 2018, 08:14:01 AM »
Per VovKa's suggestion, the regeneratetablesuppressed property is the answer - try the following:
Code - Auto/Visual Lisp: [Select]
  1. ;; Alternating Table Background Colour  -  Lee Mac
  2.  
  3. (defun c:altback ( / *error* acc col fnc idx obj row sel tmp )
  4.  
  5.     (defun *error* ( msg )
  6.         (if (and (= 'vla-object (type acc)) (not (vlax-object-released-p acc)))
  7.             (vlax-release-object acc)
  8.         )
  9.         (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
  10.             (princ (strcat "\nError: " msg))
  11.         )
  12.         (princ)
  13.     )
  14.  
  15.     (setq col '(215 215 215)) ;; True Colour (r g b) for cell background
  16.    
  17.     (if (setq sel (ssget "_:L" '((0 . "ACAD_TABLE"))))
  18.         (if (setq acc (vla-getinterfaceobject (vlax-get-acad-object) (strcat "autocad.accmcolor." (substr (getvar 'acadver) 1 2))))
  19.             (progn
  20.                 (apply 'vla-setrgb (cons acc col))
  21.                 (repeat (setq idx (sslength sel))
  22.                     (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx))))
  23.                           col (vla-get-columns obj)
  24.                     )
  25.                     (vla-put-regeneratetablesuppressed obj :vlax-true)
  26.                     (repeat (setq row (vla-get-rows obj))
  27.                         (if (zerop (rem (setq row (1- row)) 2))
  28.                             (setq fnc (lambda ( a b ) (vla-setcellbackgroundcolor obj a b acc)))
  29.                             (setq fnc (lambda ( a b ) (vla-setcellbackgroundcolornone obj a b :vlax-true)))
  30.                         )
  31.                         (repeat (setq tmp col) (fnc row (setq tmp (1- tmp))))
  32.                     )
  33.                     (vla-put-regeneratetablesuppressed obj :vlax-false)
  34.                 )
  35.                 (vlax-release-object acc)
  36.             )
  37.             (princ "\nUnable to interface with AcCmColor object.")
  38.         )
  39.     )
  40.     (princ)
  41. )

cmwade77

  • Swamp Rat
  • Posts: 1443
Re: Highlighting Every Other Row of Table
« Reply #3 on: July 11, 2018, 02:43:35 PM »
That did in deed work, but I also want to skip all rows and cells that have a style type of Title or Header. I can do it if the entire row is set as a title or header, using the code below, but I have been trying to mess around with vla-getcellstyle and haven't yet figured out how to integrate that into this code, as I am still not great with the lambda functions. I could rewrite the whole thing to not use lambda, but that would slow it down a bit, so hopefully someone has a simpler way.

Code: [Select]
;; Alternating Table Background Colour  -  Lee Mac
;; Modified by Chris Wade 07/11/2018 to ignore Title and Header rows
(defun c:altback ( / *error* acc col fnc idx obj row sel tmp RowType CellStyle1)
 
    (defun *error* ( msg )
        (if (and (= 'vla-object (type acc)) (not (vlax-object-released-p acc)))
            (vlax-release-object acc)
        )
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )
 
    (setq col '(215 215 215)) ;; True Colour (r g b) for cell background
 
    (if (setq sel (ssget "_:L" '((0 . "ACAD_TABLE"))))
        (if (setq acc (vla-getinterfaceobject (vlax-get-acad-object) (strcat "autocad.accmcolor." (substr (getvar 'acadver) 1 2))))
            (progn
                (apply 'vla-setrgb (cons acc col))
                (repeat (setq idx (sslength sel))
                    (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx))))
                          col (vla-get-columns obj)
                    )
                    (vla-put-regeneratetablesuppressed obj :vlax-true)
                    (repeat (setq row (vla-get-rows obj))
                            (setq RowType (vla-getrowtype obj row))
                        (if (and (zerop (rem (setq row (1- row)) 2)) (/= RowType acHeaderRow) (/= RowType acTitleRow))
                            (setq fnc (lambda ( a b ) (vla-setcellbackgroundcolor obj a b acc)))
                            (setq fnc (lambda ( a b ) (vla-setcellbackgroundcolornone obj a b :vlax-true)))
                        )
                        (repeat (setq tmp col) (fnc row (setq tmp (1- tmp))))
                    )
                    (vla-put-regeneratetablesuppressed obj :vlax-false)
                )
                (vlax-release-object acc)
            )
            (princ "\nUnable to interface with AcCmColor object.")
        )
    )
    (princ)
)
(vl-load-com) (princ)

cmwade77

  • Swamp Rat
  • Posts: 1443
Re: Highlighting Every Other Row of Table
« Reply #4 on: July 11, 2018, 03:09:07 PM »
Actually, I think I got it.

Code: [Select]
;; Alternating Table Background Colour  -  Lee Mac
;; Modified by Chris Wade 07/11/2018 to ignore Title and Header rows
(defun c:altback ( / *error* acc col fnc idx obj row sel tmp RowType)
 
    (defun *error* ( msg )
        (if (and (= 'vla-object (type acc)) (not (vlax-object-released-p acc)))
            (vlax-release-object acc)
        )
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )
 
    (setq col '(215 215 215)) ;; True Colour (r g b) for cell background
 
    (if (setq sel (ssget "_:L" '((0 . "ACAD_TABLE"))))
        (if (setq acc (vla-getinterfaceobject (vlax-get-acad-object) (strcat "autocad.accmcolor." (substr (getvar 'acadver) 1 2))))
            (progn
               
                (apply 'vla-setrgb (cons acc col))
                (repeat (setq idx (sslength sel))
                    (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx))))
                          col (vla-get-columns obj)
                          Rows (vla-get-rows Obj)
                          RowCt 1
                          ColCt 1
                    )
                    (vla-put-regeneratetablesuppressed obj :vlax-true)
                   
                   
                    (repeat (setq row (vla-get-rows obj))
                            (setq RowType (vla-getrowtype obj row))
                        (if (and (zerop (rem (setq row (1- row)) 2)) (/= RowType acHeaderRow) (/= RowType acTitleRow))
                            (setq fnc (lambda ( a b ) (if (and (/= (vla-getcellstyle obj a b) "_HEADER") (/= (vla-getcellstyle obj a b) "_TITLE")) (vla-setcellbackgroundcolor obj a b acc) (vla-setcellbackgroundcolornone obj a b :vlax-true))))
                            (setq fnc (lambda ( a b ) (vla-setcellbackgroundcolornone obj a b :vlax-true)))
                        )
                        (repeat (setq tmp col) (fnc row (setq tmp (1- tmp))))
                    )
                    (vla-put-regeneratetablesuppressed obj :vlax-false)
                )
                (vlax-release-object acc)
            )
            (princ "\nUnable to interface with AcCmColor object.")
        )
    )
    (princ)
)
(vl-load-com) (princ)

Grrr1337

  • Swamp Rat
  • Posts: 812
Re: Highlighting Every Other Row of Table
« Reply #5 on: July 11, 2018, 03:22:36 PM »

so hopefully someone has a simpler way.

One thing I figured out for a task that require table cells manipulation is to just prompt the user to pick the cell from where to manipulate the rest of the rows/columns.
Atleast in my case the amount of headers might be unknown (in the demo they are the 2nd and 3rd row) but that doesn't matter for the routine's algorithm (that I mentioned above) :



Btw the purpose was to sort the rows below the picked cell (inclusive) by the values from the picked column.
(apply ''((a b c)(a b c))
  '(
    (( f L ) (apply 'strcat (f L)))
    (( L ) (if L (cons (chr (car L)) (f (cdr L)))))
    (72 101 108 108 111 32 87 111 114 108 100)
  )
)
vevo.bg

cmwade77

  • Swamp Rat
  • Posts: 1443
Re: Highlighting Every Other Row of Table
« Reply #6 on: July 11, 2018, 04:31:45 PM »
My code above account for header rows as well as title rows, but any chance you can share the code for sorting rows? That is something that I kept getting asked for and while I could eventually write my own, why reinvent the wheel?

I am also going to eventually do a select row to highlight as well, as we sometimes have the need to only highlight certain rows, but that is different than this need, I didn't want people to have to select massive numbers of rows on a table with 200+ rows.

Grrr1337

  • Swamp Rat
  • Posts: 812
Re: Highlighting Every Other Row of Table
« Reply #7 on: July 11, 2018, 04:42:01 PM »
My code above account for header rows as well as title rows, but any chance you can share the code for sorting rows? That is something that I kept getting asked for and while I could eventually write my own, why reinvent the wheel?

Here you go, some f'ugly written code that I wrote/assembled for myself:
Code - Auto/Visual Lisp: [Select]
  1.  
  2. ; ACAD_Table Sort by Column
  3. ; 1. Use GetCell and collect the rows below (to skip the title and headers)
  4. ; 2. Sort by Nth (sort the rows by nth element (column)) using custom sorting function
  5. ; Grread not required
  6.  
  7. ; 1. Pick Column To Sort By (only the rows below the picked cell gonna be sorted)
  8. ; 2. ACAD_TABLE->Matrix_List
  9. ; 3. SortByNth using custom sorting function
  10. ; 4. RePopulate ACAD_TABLE using the new Matrix List
  11.  
  12. (defun C:test ( / SortByNth GetCellVals GetAllTableCells Lst->PopulateAcad_Table *error* osm cell acDoc AllCells FirstHalf SecondHalf FirstHalfVals SecondHalfVals SecondSortedVals )
  13.  
  14.  
  15.  
  16.   ; This could be used to map into the table's cells
  17.   ; Lee Mac ; https://www.theswamp.org/index.php?topic=52935.msg577618#msg577618
  18.   (defun mapncar ( n f l ) (if (< 0 n) (mapcar '(lambda ( x ) (mapncar (1- n) f x)) l) (mapcar 'f l) ) )
  19.  
  20.   ; (SortByNth 0 (lambda (L) (SortStringWithNumberAsNumber L)) L)
  21.   ; This one combines (SortByNth_vl-sort) and (SortByNth_SortingFoo)
  22.   ; Sort Matrix Assoc List By Nth - by applying list-sorting function as a foo
  23.   (defun SortByNth ( n foo L / nL snL )
  24.     (setq nL (mapcar '(lambda (x) (nth n x)) L)) ; List of nth atoms to be sorted
  25.     (setq snL (apply (function foo) (list nL))) ; List of sorted nth atoms
  26.     (vl-sort L '(lambda (a b) (< (vl-position (nth n a) snL) (vl-position (nth n b) snL))))
  27.   ); SortByNth
  28.  
  29.   (defun GetCellVals (L) (mapcar (function (lambda (x) (apply 'vla-GetText x))) L))
  30.  
  31.   (defun GetAllTableCells ( obj / col lst row tmp ) ; Based on Lee Mac's Example
  32.     (repeat (setq row (vla-get-rows obj)) (repeat (setq row (1- row) col (vla-get-columns obj)) (setq tmp (cons (list obj row (setq col (1- col))) tmp)) )
  33.       (setq lst (cons tmp lst) tmp nil)
  34.     )
  35.     lst
  36.   ); defun GetAllTableCells
  37.  
  38.   (defun Lst->PopulateAcad_Table ( o L / r c ) ; Based on Lee Mac's Example
  39.     (cond
  40.       ( (and (eq (type o) 'VLA-OBJECT) (eq (vla-get-ObjectName o) "AcDbTable"))
  41.         (vla-put-RegenerateTableSuppressed o :vlax-true)
  42.         (setq r 0) (foreach itm L (setq c 0) (foreach x itm (vla-SetCellValue o r c x) (setq c (1+ c)) ) (setq r (1+ r)) )
  43.         (vla-put-RegenerateTableSuppressed o :vlax-false)
  44.       )
  45.     ); cond
  46.   ); defun Lst->PopulateAcad_Table
  47.  
  48.   (defun *error* ( m )
  49.     (and osm (setvar 'osmode osm))
  50.     (and m (princ m)) (princ)
  51.   ); defun *error*
  52.  
  53.   (and
  54.     (setq osm (getvar 'osmode))
  55.     (setvar 'osmode 0)
  56.   ); and
  57.  
  58.   (cond
  59.     ( (not (setq cell (GetTableCell "Specify Table Cell to Start Sorting From By its Column"))) (princ "\nTable Cell not specified.") ) ; (o r c)
  60.     (T
  61.       (setq AllCells (GetAllTableCells (car cell)))
  62.       (setq FirstHalf  (vl-remove-if-not (function (lambda (x) (> (cadr cell) (cadar x)))) AllCells))
  63.       (setq SecondHalf  (vl-remove-if-not (function (lambda (x) (<= (cadr cell) (cadar x)))) AllCells)) ; To be sorted
  64.       (setq FirstHalfVals (mapcar 'GetCellVals FirstHalf))
  65.       (setq SecondHalfVals (mapcar 'GetCellVals SecondHalf))
  66.       (setq SecondSortedVals (SortByNth (caddr cell) (lambda (L) (SortStringWithNumberAsNumber L)) SecondHalfvals))
  67.       (and (progn (initget "Yes No") (= "Yes" (cond ((getkword "\nReverse sorting? [Yes/No] <No>: ")) ("No")))) (setq SecondSortedVals (reverse SecondSortedVals)))
  68.       (vla-put-RegenerateTableSuppressed (car cell) :vlax-true)
  69.       (Lst->PopulateAcad_Table (car cell)   (append FirstHalfVals SecondSortedVals))
  70.       (vla-put-RegenerateTableSuppressed (car cell) :vlax-false)
  71.       (vla-EndundoMark acDoc)
  72.     ); T
  73.   ); cond
  74.   (*error* nil)
  75.   (princ)
  76. ); defun
  77.  
  78.  
  79.  
  80. ; http://www.theswamp.org/index.php?topic=16564.msg207439#msg207439
  81. ;; Usage (SortStringWithNumberAsNumber '("A9" "A1" "A10" "B11" "B2" "B05"))
  82. ;; Return ("A1" "A9" "A10" "B2" "B05" "B11")
  83. (defun SortStringWithNumberAsNumber (ListOfString)
  84.   ;;; Function Normalize (add 0 befor number) number in string
  85.   ;;; Count normalize symbols set in variable count
  86.   (defun NormalizeNumberInString (str / ch i pat ret count buf)
  87.     (setq i     0
  88.       pat   '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9")
  89.       ret   ""
  90.       count 4 ;_Count normalize symbols
  91.     ) ;_ end of setq
  92.     (while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
  93.       (if (vl-position ch pat)
  94.         (progn
  95.           (setq buf ch) ;_ end of setq
  96.           (while
  97.             (vl-position (setq ch (substr str (setq i (1+ i)) 1)) pat)
  98.             (setq buf (strcat buf ch))
  99.           ) ;_ end of while
  100.           (while (< (strlen buf) count) (setq buf (strcat "0" buf)))
  101.           (setq ret (strcat ret buf))
  102.         ) ;_ end of progn
  103.       ) ;_ end of if
  104.       (setq ret (strcat ret ch))
  105.     ) ;_ end of while
  106.     ret
  107.   ) ;_ end of defun
  108.   (mapcar '(lambda (x) (nth x ListOfString)) (vl-sort-i (mapcar 'NormalizeNumberInString ListOfString) '<))
  109. ) ;_ end of defun
  110.  
  111.  
  112. ; (if (setq cell (GetTableCell nil)) (apply '(lambda (o r c) (vlax-invoke o 'GetCellValue r c)) cell)) ; will return the vlax-variant-value
  113. ; (if (setq cell (GetTableCell nil)) (apply 'vla-GetCellValue cell)) ; will return variant
  114. ; _$ (GetTableCell nil) -> (#<VLA-OBJECT IAcadTable 0000010540176cd8> 2 2) ; Example, returns a list of (o r c)
  115. (defun GetTableCell ( msg / HitTest GetAcadTableObjects atL Stop p r )
  116.  
  117.   (defun HitTest ( pt lst ) ; Lee Mac
  118.     (if (and (vl-consp pt) (vl-every 'numberp pt))
  119.       (vl-some
  120.         (function
  121.           (lambda ( o / r c )
  122.             (if (eq :vlax-true (vla-HitTest o (vlax-3D-point (trans pt 1 0)) (vlax-3D-point (trans (getvar 'VIEWDIR) 1 0)) 'r 'c)) (list o r c) )
  123.           )
  124.         )
  125.         lst
  126.       ); vl-some
  127.     ); if
  128.   ); defun HitTest
  129.  
  130.   (defun GetAcadTableObjects ( / SS i L )
  131.     (if (setq SS (ssget "X" (list '(0 . "ACAD_TABLE") (if (= 1 (getvar 'cvport)) (cons 410 (getvar 'ctab)) '(410 . "Model")))))
  132.       (repeat (setq i (sslength SS)) (setq L (cons (vlax-ename->vla-object (ssname SS (setq i (1- i)))) L)) )
  133.     ); if
  134.   ); defun GetAcadTableObjects
  135.  
  136.   (if (setq atL (GetAcadTableObjects))
  137.     (while (not Stop)
  138.       (initget "eXit") (setq p (getpoint (strcat "\n" (if (eq 'STR (type msg)) msg "Specify Table Cell") " or [eXit]: ")))
  139.       (cond
  140.         ( (eq 'STR (type p)) (setq Stop T) )
  141.         ( (not (setq r (HitTest p atL))) (princ "\nInvalid point.") )
  142.         (T (setq Stop T))
  143.       ); cond
  144.     ); while
  145.     (princ "\nNo ACAD_TABLEs found in this drwaing.")
  146.   ); if
  147.   r
  148. ); defun GetTableCell
  149.  

But originally I was throwing ideas at Lee.
(apply ''((a b c)(a b c))
  '(
    (( f L ) (apply 'strcat (f L)))
    (( L ) (if L (cons (chr (car L)) (f (cdr L)))))
    (72 101 108 108 111 32 87 111 114 108 100)
  )
)
vevo.bg

cmwade77

  • Swamp Rat
  • Posts: 1443
Re: Highlighting Every Other Row of Table
« Reply #8 on: July 11, 2018, 04:47:37 PM »
Awesome, thank you, I am going to have to account for tables where I have Total rows at the bottom and prevent them from getting sorted, but this is a huge head start, thank you.

cmwade77

  • Swamp Rat
  • Posts: 1443
Re: Highlighting Every Other Row of Table
« Reply #9 on: July 11, 2018, 06:21:20 PM »
Here is what I came up with for that:



Code: [Select]
; Modified by Chris Wade on 07/11/2018 to be able to specify a number of "Total" rows at the bottom of a table to not include in the sorting.
; ACAD_Table Sort by Column
; 1. Use GetCell and collect the rows below (to skip the title and headers)
; 2. Sort by Nth (sort the rows by nth element (column)) using custom sorting function
; Grread not required
 
; 1. Pick Column To Sort By (only the rows below the picked cell gonna be sorted)
; 2. ACAD_TABLE->Matrix_List
; 3. SortByNth using custom sorting function
; 4. RePopulate ACAD_TABLE using the new Matrix List
 
(defun C:SortTable ( / SortByNth GetCellVals GetAllTableCells Lst->PopulateAcad_Table *error* osm cell acDoc AllCells FirstHalf SecondHalf FirstHalfVals SecondHalfVals SecondSortedVals TotalRows)
 
 
 
  ; This could be used to map into the table's cells
  ; Lee Mac ; https://www.theswamp.org/index.php?topic=52935.msg577618#msg577618
  (defun mapncar ( n f l ) (if (< 0 n) (mapcar '(lambda ( x ) (mapncar (1- n) f x)) l) (mapcar 'f l) ) )
 
  ; (SortByNth 0 (lambda (L) (SortStringWithNumberAsNumber L)) L)
  ; This one combines (SortByNth_vl-sort) and (SortByNth_SortingFoo)
  ; Sort Matrix Assoc List By Nth - by applying list-sorting function as a foo
  (defun SortByNth ( n foo L / nL snL )
    (setq nL (mapcar '(lambda (x) (nth n x)) L)) ; List of nth atoms to be sorted
    (setq snL (apply (function foo) (list nL))) ; List of sorted nth atoms
    (vl-sort L '(lambda (a b) (< (vl-position (nth n a) snL) (vl-position (nth n b) snL))))
  ); SortByNth
 
  (defun GetCellVals (L) (mapcar (function (lambda (x) (apply 'vla-GetText x))) L))
 
  (defun GetAllTableCells ( obj TotalRows / col lst row tmp ) ; Based on Lee Mac's Example
    (repeat (setq row (- (vla-get-rows obj) TotalRows)) (repeat (setq row (1- row) col (vla-get-columns obj)) (setq tmp (cons (list obj row (setq col (1- col))) tmp)) )
      (setq lst (cons tmp lst) tmp nil)
    )
    lst
  ); defun GetAllTableCells
 
  (defun Lst->PopulateAcad_Table ( o L / r c ) ; Based on Lee Mac's Example
    (cond
      ( (and (eq (type o) 'VLA-OBJECT) (eq (vla-get-ObjectName o) "AcDbTable"))
        (vla-put-RegenerateTableSuppressed o :vlax-true)
        (setq r 0) (foreach itm L (setq c 0) (foreach x itm (vla-SetCellValue o r c x) (setq c (1+ c)) ) (setq r (1+ r)) )
        (vla-put-RegenerateTableSuppressed o :vlax-false)
      )
    ); cond
  ); defun Lst->PopulateAcad_Table
 
  (defun *error* ( m )
    (and osm (setvar 'osmode osm))
    (and m (princ m)) (princ)
  ); defun *error*
 
  (and
    (setq osm (getvar 'osmode))
    (setvar 'osmode 0)
  ); and
 
  (cond
    ( (not (setq cell (GetTableCell "Specify Table Cell to Start Sorting From By its Column"))) (princ "\nTable Cell not specified.") ) ; (o r c)
    (T
      (setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object))) (or (vla-EndundoMark acDoc) (vla-StartUndoMark acDoc))
      (setq TotalRows (getint "\nEnter number of 'Total Rows' at bottom of table that should not be sorted (0 for none):"))
      (setq AllCells (GetAllTableCells (car cell) TotalRows))
      (setq FirstHalf  (vl-remove-if-not (function (lambda (x) (> (cadr cell) (cadar x)))) AllCells))
      (setq SecondHalf  (vl-remove-if-not (function (lambda (x) (<= (cadr cell) (cadar x)))) AllCells)) ; To be sorted
      (setq FirstHalfVals (mapcar 'GetCellVals FirstHalf))
      (setq SecondHalfVals (mapcar 'GetCellVals SecondHalf))
      (setq SecondSortedVals (SortByNth (caddr cell) (lambda (L) (SortStringWithNumberAsNumber L)) SecondHalfvals))
      (and (progn (initget "Yes No") (= "Yes" (cond ((getkword "\nReverse sorting? [Yes/No] <No>: ")) ("No")))) (setq SecondSortedVals (reverse SecondSortedVals)))
      (vla-put-RegenerateTableSuppressed (car cell) :vlax-true)
      (Lst->PopulateAcad_Table (car cell)   (append FirstHalfVals SecondSortedVals))
      (vla-put-RegenerateTableSuppressed (car cell) :vlax-false)
      (vla-EndundoMark acDoc)
    ); T
  ); cond
  (*error* nil)
  (princ)
); defun
 
 
 
; http://www.theswamp.org/index.php?topic=16564.msg207439#msg207439
;; Usage (SortStringWithNumberAsNumber '("A9" "A1" "A10" "B11" "B2" "B05"))
;; Return ("A1" "A9" "A10" "B2" "B05" "B11")
(defun SortStringWithNumberAsNumber (ListOfString)
  ;;; Function Normalize (add 0 befor number) number in string
  ;;; Count normalize symbols set in variable count
  (defun NormalizeNumberInString (str / ch i pat ret count buf)
    (setq i     0
      pat   '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9")
      ret   ""
      count 4 ;_Count normalize symbols
    ) ;_ end of setq
    (while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
      (if (vl-position ch pat)
        (progn
          (setq buf ch) ;_ end of setq
          (while
            (vl-position (setq ch (substr str (setq i (1+ i)) 1)) pat)
            (setq buf (strcat buf ch))
          ) ;_ end of while
          (while (< (strlen buf) count) (setq buf (strcat "0" buf)))
          (setq ret (strcat ret buf))
        ) ;_ end of progn
      ) ;_ end of if
      (setq ret (strcat ret ch))
    ) ;_ end of while
    ret
  ) ;_ end of defun
  (mapcar '(lambda (x) (nth x ListOfString)) (vl-sort-i (mapcar 'NormalizeNumberInString ListOfString) '<))
) ;_ end of defun
 
 
; (if (setq cell (GetTableCell nil)) (apply '(lambda (o r c) (vlax-invoke o 'GetCellValue r c)) cell)) ; will return the vlax-variant-value
; (if (setq cell (GetTableCell nil)) (apply 'vla-GetCellValue cell)) ; will return variant
; _$ (GetTableCell nil) -> (#<VLA-OBJECT IAcadTable 0000010540176cd8> 2 2) ; Example, returns a list of (o r c)
(defun GetTableCell ( msg / HitTest GetAcadTableObjects atL Stop p r )
 
  (defun HitTest ( pt lst ) ; Lee Mac
    (if (and (vl-consp pt) (vl-every 'numberp pt))
      (vl-some
        (function
          (lambda ( o / r c )
            (if (eq :vlax-true (vla-HitTest o (vlax-3D-point (trans pt 1 0)) (vlax-3D-point (trans (getvar 'VIEWDIR) 1 0)) 'r 'c)) (list o r c) )
          )
        )
        lst
      ); vl-some
    ); if
  ); defun HitTest
 
  (defun GetAcadTableObjects ( / SS i L )
    (if (setq SS (ssget "X" (list '(0 . "ACAD_TABLE") (if (= 1 (getvar 'cvport)) (cons 410 (getvar 'ctab)) '(410 . "Model")))))
      (repeat (setq i (sslength SS)) (setq L (cons (vlax-ename->vla-object (ssname SS (setq i (1- i)))) L)) )
    ); if
  ); defun GetAcadTableObjects
 
  (if (setq atL (GetAcadTableObjects))
    (while (not Stop)
      (initget "eXit") (setq p (getpoint (strcat "\n" (if (eq 'STR (type msg)) msg "Specify Table Cell") " or [eXit]: ")))
      (cond
        ( (eq 'STR (type p)) (setq Stop T) )
        ( (not (setq r (HitTest p atL))) (princ "\nInvalid point.") )
        (T (setq Stop T))
      ); cond
    ); while
    (princ "\nNo ACAD_TABLEs found in this drwaing.")
  ); if
  r
); defun GetTableCell

ahsattarian

  • Newt
  • Posts: 112
Re: Highlighting Every Other Row of Table
« Reply #10 on: January 21, 2021, 09:08:04 AM »
This is Better :


Code - Auto/Visual Lisp: [Select]
  1. (defun c:a ()
  2.   (setq s (car (entsel "\n select Table : ")))
  3.   (setq clr '(100 100 100))
  4.   (setq txt (strcat "autocad.accmcolor." (substr (getvar 'acadver) 1 2)))
  5.   (apply 'vla-setrgb (cons acc clr))
  6.   (setq obj (vlax-ename->vla-object s))
  7.   (setq col (vla-get-columns obj))
  8.   (setq row (vla-get-rows obj))
  9.   (vla-put-regeneratetablesuppressed obj :vlax-true)
  10.   (setq i -1)
  11.   (repeat row
  12.     (setq i (1+ i))
  13.     (setq j -1)
  14.     (repeat col
  15.       (setq j (1+ j))
  16.       (if (zerop (rem i 2))
  17.         (vla-setcellbackgroundcolor obj i j acc)
  18.         (vla-setcellbackgroundcolornone obj i j :vlax-true)
  19.       )
  20.     )
  21.   )
  22.   (vla-put-regeneratetablesuppressed obj :vlax-false)
  23.   (princ)
  24. )




cmwade77

  • Swamp Rat
  • Posts: 1443
Re: Highlighting Every Other Row of Table
« Reply #11 on: January 21, 2021, 12:34:02 PM »
What exactly makes it better? Just curious, as Lee is pretty good at ensuring his routines have error checking, etc.

ronjonp

  • Needs a day job
  • Posts: 7526
Re: Highlighting Every Other Row of Table
« Reply #12 on: January 21, 2021, 12:49:45 PM »
This is Better :


Code - Auto/Visual Lisp: [Select]
  1. (defun c:a ()
  2.   (setq s (car (entsel "\n select Table : ")))
  3.   (setq clr '(100 100 100))
  4.   (setq txt (strcat "autocad.accmcolor." (substr (getvar 'acadver) 1 2)))
  5.   (apply 'vla-setrgb (cons acc clr))
  6.   (setq obj (vlax-ename->vla-object s))
  7.   (setq col (vla-get-columns obj))
  8.   (setq row (vla-get-rows obj))
  9.   (vla-put-regeneratetablesuppressed obj :vlax-true)
  10.   (setq i -1)
  11.   (repeat row
  12.     (setq i (1+ i))
  13.     (setq j -1)
  14.     (repeat col
  15.       (setq j (1+ j))
  16.       (if (zerop (rem i 2))
  17.         (vla-setcellbackgroundcolor obj i j acc)
  18.         (vla-setcellbackgroundcolornone obj i j :vlax-true)
  19.       )
  20.     )
  21.   )
  22.   (vla-put-regeneratetablesuppressed obj :vlax-false)
  23.   (princ)
  24. )

Far from better:  :?

No localized variables: (defun c:a ( / ACC CLR COL I J OBJ ROW S TXT)
No check for missed pick
No check that a TABLE object is picked
The truecolor object can be simplified to this: (vla-get-truecolor (vlax-ename->vla-object s))
The TITLE cell changes color too

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC