How to select the cell in a table

[muthu123]

Dear all,

 

Please explain with examples to select some cells in a autoCAD table and it should return the row and column index.

 

How to apply the below fucntions in lisp?

 

vla-SelectSubRegion

vla-Select

[Lee Mac]

This thread may help you.

[pBe]

To get the Row and Column number for a table with an existing value on a cell via selection on screen:

 

Try HitTest

(defun c:test (/ a b c)
(setq a (entsel)
     b (vlax-ename->vla-object (car a)))
(vla-HitTest
  b
  (vlax-3d-point (cadr a))
  (vlax-3d-point (trans (getvar 'ViewDir) 1 0))
  'Rw
  'Cl
)
 (print rw) 
 (print cl)
 ;;;; (do your thing here...) ;;;;
   (princ)
 )

 

Otherwise use Lee's code

[muthu123]

Dear Lee,

 

I have achieved my requirement by my code given below. But only thing is i want to highlight the cells the user selected. The method (Vla-highlight) is high lighting the whole table. Please suggest me.

 

;*******************************************************************************************
;*******************************************************************************************
;*******************************************************************************************
(defun C:adt (/ *number* *pt1* *pt2* atable sset)
 (Setq *pt1* (getpoint "\nPick First Corner in a table")
       *pt2* (getcorner *pt1* "\nPick other corner in same table")
 )
 (setq sset (Ssget "C" *pt1* *pt2* '((0 . "ACAD_TABLE"))))
 (if (and sset (= (sslength sset) 1))
   (progn (setq *number* (getreal "\nNumber to be added : "))
          (Setq atable (vlax-ename->vla-object (ssname sset 0)))
          (update_selected_cells atable)
   )
   (Alert "Please select Inside of single table")
 )
 (princ)
)
;*******************************************************************************************
;*******************************************************************************************
;*******************************************************************************************
(defun check_falling (pt corner_pt1 corner_pt2 / result x1 x2 y1 y2)
 (setq x1 (min (Car corner_pt1) (Car corner_pt2))
       x2 (max (Car corner_pt1) (Car corner_pt2))
       y1 (min (Cadr corner_pt1) (Cadr corner_pt2))
       y2 (max (Cadr corner_pt1) (Cadr corner_pt2))
 )
 (if (and (> (Car pt) x1)
          (< (Car pt) x2)
          (> (Cadr pt) y1)
          (< (Cadr pt) y2)
     )
   (setq result t)
   (setq result nil)
 )
 result
)
;*******************************************************************************************
;*******************************************************************************************
;*******************************************************************************************
(defun update_selected_cells (atable      /           #i          #list       column_no
                             dum_pt1     dum_pt2     dum_pt3     dum_pt4     i
                             list_of_cells           new_str     no_of_columns
                             no_of_rows  old_str     return_list row_no      sset
                             text        x
                            )
 (setq no_of_rows    (vla-get-rows atable)
       no_of_columns (vla-get-columns atable)
       row_no        0
 )
 (repeat no_of_rows
   (Setq column_no 0)
   (repeat no_of_columns
     (Setq return_list (vlax-safearray->list
                         (vlax-variant-value (vla-GetCellExtents atable row_no column_no t))
                       )
     )
     (Setq dum_pt1 (extract_list 0 2 return_list)
           dum_pt2 (extract_list 3 5 return_list)
           dum_pt3 (extract_list 6 8 return_list)
           dum_pt4 (extract_list 9 11 return_list)
     )
     (if (or (check_falling dum_pt1 *pt1* *pt2*)
             (check_falling dum_pt2 *pt1* *pt2*)
             (check_falling dum_pt3 *pt1* *pt2*)
             (check_falling dum_pt4 *pt1* *pt2*)
         )
       (setq list_of_cells (append list_of_cells (list (list row_no column_no))))
     )
     (Setq column_no (1+ column_no))
   )
   (Setq row_no (1+ row_no))
 )
 (mapcar '(lambda (x)
            (Setq text (vla-gettext atable (Car x) (cadr x)))
            (Setq #list (reverse (vl-string->list text)))
            (if #list
              (progn (setq i 0)
                     (while (or (and (>= (nth i #list) 48) (<= (nth i #list) 57))
                                (= (nth i #list) 46)
                            )
                       (Setq i (1+ i))
                     )
                     (if (> i 0)
                       (progn (Setq old_str (substr text 1 (- (strlen text) i)))
                              (setq new_str
                                     (Strcat old_str
                                             (rtos (+ (atof (substr text (- (strlen text) (1- i)) (strlen text)))
                                                      *number*
                                                   )
                                                   2
                                                   0
                                             )
                                     )
                              )
                              (vla-settext atable (Car x) (cadr x) new_str)
                       )
                     )
              )
            )
          )
         list_of_cells
 )
)
;*******************************************************************************************
;*******************************************************************************************
;*******************************************************************************************
(defun extract_list (#start #end #List / #Index cnt)
 (setq cnt -1)
 (vl-remove-if '(lambda (x) (setq cnt (1+ cnt)) (or (< cnt #start) (> cnt #end)))
               #List
 )
)
;*******************************************************************************************
;*******************************************************************************************
;*******************************************************************************************

This thread may help you.

[Lee Mac]

Quick example:

 

(defun c:test ( / _ss->lst _hit-test acapp acdoc l1 l2 p1 p2 pt ss )

   ;; Example by Lee Mac 2011  -  www.lee-mac.com

   (defun _ss->lst ( ss / i lst )
       (repeat (setq i (sslength ss))
           (setq lst (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) lst))
       )
   )

   (defun _hit-test ( pt lst )
       (vl-some
           (function
               (lambda ( obj / row col )
                   (if
                       (eq :vlax-true
                           (vla-hittest obj (vlax-3D-point (trans pt 1 0))
                               (vlax-3D-point (trans (getvar 'VIEWDIR) 1 0)) 'row 'col
                           )
                       )
                       (list obj row col)
                   )
               )
           )
           lst
       )
   )

   (setq acapp (vlax-get-acad-object)
         acdoc (vla-get-activedocument acapp)
   )
   (if (setq ss (ssget "_X" (list (cons 0 "ACAD_TABLE") (cons 410 (getvar 'CTAB)))))
       (progn
           (setq ss (_ss->lst ss))
           (while
               (and
                   (setq p1 (getpoint "\nSpecify First Corner: "))
                   (not (setq l1 (_hit-test p1 ss)))
               )
               (princ "\nPoint does not lie in Table Cell.")
           )
           (if p1
               (progn
                   (while
                       (and
                           (setq p2 (getcorner p1 "\nSpecify Opposite Corner: "))
                           (not (setq l2 (_hit-test p2 (list (car l1)))))
                       )
                       (princ "\nPoint not valid.")
                   )
                   (if p2
                       (vla-setsubselection (car l1) (cadr l1) (cadr l2) (caddr l1) (caddr l2))
                   )
               )
           )
       )
       (princ "\nNo Tables found in drawing.")
   )
   (princ)
)
(vl-load-com) (princ)

[martinle]

sorry Herr Lee

[muthu123]

Quick example:

 

(defun c:test ( / _ss->lst _hit-test acapp acdoc l1 l2 p1 p2 pt ss )

   ;; Example by Lee Mac 2011  -  www.lee-mac.com

   (defun _ss->lst ( ss / i lst )
       (repeat (setq i (sslength ss))
           (setq lst (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) lst))
       )
   )

   (defun _hit-test ( pt lst )
       (vl-some
           (function
               (lambda ( obj / row col )
                   (if
                       (eq :vlax-true
                           (vla-hittest obj (vlax-3D-point (trans pt 1 0))
                               (vlax-3D-point (trans (getvar 'VIEWDIR) 1 0)) 'row 'col
                           )
                       )
                       (list obj row col)
                   )
               )
           )
           lst
       )
   )

   (setq acapp (vlax-get-acad-object)
         acdoc (vla-get-activedocument acapp)
   )
   (if (setq ss (ssget "_X" (list (cons 0 "ACAD_TABLE") (cons 410 (getvar 'CTAB)))))
       (progn
           (setq ss (_ss->lst ss))
           (while
               (and
                   (setq p1 (getpoint "\nSpecify First Corner: "))
                   (not (setq l1 (_hit-test p1 ss)))
               )
               (princ "\nPoint does not lie in Table Cell.")
           )
           (if p1
               (progn
                   (while
                       (and
                           (setq p2 (getcorner p1 "\nSpecify Opposite Corner: "))
                           (not (setq l2 (_hit-test p2 (list (car l1)))))
                       )
                       (princ "\nPoint not valid.")
                   )
                   (if p2
                       (vla-setsubselection (car l1) (cadr l1) (cadr l2) (caddr l1) (caddr l2))
                   )
               )
           )
       )
       (princ "\nNo Tables found in drawing.")
   )
   (princ)
)
(vl-load-com) (princ)

Dear Mr.Lee,

Please refer the attachment for reference.

 

We need to highlight the selected cells by giving two points (two corner points).

[Lee Mac]

Did you try the code?!?

[muthu123]

Yes. But it doesn't highlight the cells.

[Lee Mac]

Yes. But it doesn't highlight the cells.

 

What messages do you receive then? If any? Does the program error?

 

Here is the result on my system:

 

[muthu123]

There is no error. But it is not high lighting as your image and simply executing.

[muthu123]

 

This is the output from my system.

[fixo]

Here is my 2c

(vl-load-com) 
;; local function by gile
(defun CrossProduct (v1 v2)
 (list (- (* (cadr v1) (caddr v2)) (* (caddr v1) (cadr v2)))
(- (* (caddr v1) (car v2)) (* (car v1) (caddr v2)))
(- (* (car v1) (cadr v2)) (* (cadr v1) (car v2)))
 )
)
(defun C:hitcell (/ acapp  adoc atable col cp1 cp2 midp pfset row vec    xdir ydir zdir)
           (if
      (and
 (setq cp1 (getpoint "\nSpecify First Cell Corner: "))
 (setq cp2 (getcorner cp1 "\nSpecify Opposite Corner: "))
 )
       (progn
  (setq midp (trans (mapcar (function (lambda (a b) (/ (+ a b) 2))) cp1 cp2)
      0
      1))
  (setq acapp (vlax-get-acad-object)
        adoc  (vla-get-activedocument acapp)
        pfset (vla-get-pickfirstselectionset adoc))
  (vla-clear pfset)
  (vla-select
    pfset
    acSelectionSetCrossing
    (vlax-3d-point cp1)
    (vlax-3d-point cp2)
    (vlax-safearray-fill
      (vlax-make-safearray vlax-vbinteger '(0 . 0))
      '(0))
    (vlax-safearray-fill
      (vlax-make-safearray vlax-vbvariant '(0 . 0))
      '("ACAD_TABLE")
      )
    )
  (if (> (vla-get-count pfset) 0)
    (progn
      (setq atable (vla-item pfset 0))
      (setq xdir (getvar "UCSXDIR")
     ydir (getvar "UCSYDIR")
     zdir (CrossProduct xdir ydir))

      (setq vec (vlax-make-variant
    (vlax-safearray-fill
      (vlax-make-safearray vlax-vbDouble '(0 . 2))
      zdir))
     )     ;<-- equal to :(setq vec (vlax-3d-point zdir))
      (if (eq :vlax-true
       (vla-hittest
         atable
         (vlax-3d-point (trans midp 1 0))
         vec
         'row
         'col))
        (vla-setsubselection atable row row col col)
        )
      )
    )
  )
      )
(princ)
)

 

~'J'~

[muthu123]

Dear Mr.Fixo,

 

Thank you for your reply. But the result is same and it is not highlighting the cells. Now i have doubt that in my PC settings.