[编程交流] 如何在ta中选择单元格

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

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

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