Author Topic: Getting Coordinates of Table Cell/Row/Column from Picked Point  (Read 1700 times)

0 Members and 1 Guest are viewing this topic.

cmwade77

  • Swamp Rat
  • Posts: 1443
Getting Coordinates of Table Cell/Row/Column from Picked Point
« on: November 17, 2020, 07:36:29 PM »
I have cobbled together some code that will give me various coordinates of columns/rows/cells in a table based on where the user picks. I have my code below, but I am sure I am missing something and there has to be a better way to accomplish this. Looking for any input at this point.

Code: [Select]
(defun c:CheckTable (/ Pt1 TableInfo CellUpperLeft CellLowerRight TableCell RowUpperLeft RowLowerRight ColumnUpperLeft ColumnLowerRight)
  ;Supporting Functions
  (defun CW:GetTableCell (Pt1 / Result Tables ent Table PointOnTable)
    ;Supporting Functions
    ;Routine to output information with some blank lines
    (defun Output (msg)
      (princ "\n")(princ msg)(princ "\n")
    )
   
    (Defun LM: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 ); Grrr1337
      (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
    ;End Supporting Functions
    (setq Tables (Getacadtableobjects))
    (LM:Hittest Pt1 Tables)
  )
 
 
  (defun CW:GetCoordinates (TableInfo *RowUpperLeft *RowLowerRight *ColumnUpperLeft *ColumnLowerRight *CellUpperLeft *CellLowerRight / TotalColumnHeight Ct Obj Row Column Rows Columns InsPt ColumnCount RowCount ColumnDistance RowDistance)
    ;Supporting Functions
    (defun d2r (NumberOfDegrees)
      (* pi (/ numberOfDegrees 180.0))
    )
   
   
    ;End Supporting Functions
    (setq Obj (nth 0 TableInfo)
          Row (nth 1 TableInfo)
          Column (nth 2 TableInfo)
          Rows (vla-get-rows Obj)
          Columns (vla-get-columns Obj)
          InsPt (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint Obj)))
          ColumnCount 0
          RowCount 0
          ColumnDistance 0
          RowDistance 0
          Ct 0
    )
    (while (< ColumnCount Column)
      (setq ColumnDistance (+ ColumnDistance (vla-getcolumnwidth Obj ColumnCount))
            ColumnCount (+ ColumnCount 1)
      )
      (output (vla-getcolumnwidth Obj ColumnCount));column widths
    )
    (while (< Ct Rows)
      (setq TotalColumnHeight (+ (vla-getrowheight Obj Ct))
            Ct (+ ct 1)
      )
    )
    (while (< RowCount Row)
      (setq RowDistance (+ RowDistance (vla-getrowheight Obj RowCount))
            RowCount (+ RowCount 1)
      )
    )
    (set *ColumnUpperLeft (polar InsPt 0 ColumnDistance))
    (set *ColumnLowerRight (polar (polar (eval *ColumnUpperLeft 0 (vla-getcolumnwidth Obj Column)) TotalColumnHeight)))
    (set *RowUpperLeft (polar InsPt (d2r 270) RowDistance))
    (set *RowLowerRight (polar (polar (eval *RowUpperLeft) 0 (vla-get-width Obj)) (d2r 270) (vla-getrowheight Obj Row)))
    (set *CellUpperLeft (polar (polar InsPt 0 ColumnDistance) (d2r 270) RowDistance))
    (set *CellLowerRight (polar (polar (eval *CellUpperLeft) 0 (vla-getcolumnwidth Obj Column)) (d2r 270) (vla-getrowheight Obj Row)))
  )
  ;End of Supporting Functions
 
  (setq Pt1 (getpoint "\nPick point on table: ")
        TableInfo (CW:GetTableCell Pt1)
  )
  (cw:GetCoordinates TableInfo 'RowUpperLeft 'RowLowerRight 'ColumnUpperLeft 'ColumnLowerRight 'CellUpperLeft 'CellLowerRight)
 
  ;Output Information:
  (output "ColumnUpperLeft: ")
  (output ColumnUpperLeft)
  (output "ColumnLowerRight: ")
  (output ColumnLowerRight)
  (output "CellUpperLeft: ")
  (output CellUpperLeft)
  (output "CellLowerRight: ")
  (output CellLowerRight)
  (output "RowUpperLeft: ")
  (output RowUpperLeft)
  (output "RowLowerRight")
  (output RowLowerRight)
)

BIGAL

  • Swamp Rat
  • Posts: 1396
  • 40 + years of using Autocad
Re: Getting Coordinates of Table Cell/Row/Column from Picked Point
« Reply #1 on: November 18, 2020, 03:19:32 AM »
Try contacting Lee Mac at his website.
A man who never made a mistake never made anything

cmwade77

  • Swamp Rat
  • Posts: 1443
Re: Getting Coordinates of Table Cell/Row/Column from Picked Point
« Reply #2 on: November 18, 2020, 11:46:08 AM »
Try contacting Lee Mac at his website.
Yeah, I could go that route (although with the amount of code of his that my routines use, I definitely owe him at least a steak dinner if he ever makes it out my way), but I figured I would try it myself first and get input from others, as you can see, it does still use some of his code as well.

Lee Mac

  • Seagull
  • Posts: 12905
  • London, England

cmwade77

  • Swamp Rat
  • Posts: 1443
Re: Getting Coordinates of Table Cell/Row/Column from Picked Point
« Reply #4 on: November 19, 2020, 02:06:02 PM »
See this thread:
https://www.theswamp.org/index.php?topic=48553.0

Yep, I knew there had to be an easier way, although I found the bugs in my code above and the code below seems to work well. At some point, I may go through and try to integrate the code from that thread to see if it can simplify the code some.

Code: [Select]
(defun c:CheckTable (/ Obj Pt1 Pt2 TableInfo TableUpperLeft TableLowerRight CellUpperLeft CellLowerRight TableCell RowUpperLeft RowLowerRight ColumnUpperLeft ColumnLowerRight Option)
  ;Supporting Functions

  ;Draws a rectangle based on two points. Points must be diagonal from each other.
  (defun CW:DrawRectangle (Pt1 Pt2 / boxlist Doc Spc)
    ;Supporting Functions
    ;; Active Space  -  Lee Mac
    ;; Retrieves pointers to the Active Document and Space.
    ;; *doc - quoted symbol (other than *doc)
    ;; *spc - quoted symbol (other than *spc)

    (defun LM:ActiveSpace ( *doc *spc )
        (set *doc (vla-get-activedocument (vlax-get-acad-object)))
        (set *spc (vlax-get-property (eval *doc) (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace)))
        nil
    )
   
    ;;  by CAB 10/05/2007
    ;;  Expects pts to be a list of 2D or 3D points
    ;;  Returns new pline object
    (defun CAB:makePline (spc pts)
      ;;  flatten the point list to 2d
      (if (= (length (car pts)) 2) ; 2d point list
        (setq pts (apply 'append pts))
        (setq pts (apply 'append (mapcar '(lambda (x) (list (car x) (cadr x))) pts)))
      )
      (setq
        pts (vlax-make-variant
              (vlax-safearray-fill
                (vlax-make-safearray vlax-vbdouble (cons 0 (1- (length pts))))
                pts
              )
            )
      )
      (vla-addlightweightpolyline spc pts)
    )
    ;End of Supporting Functions
   
    (defun CW:DrawBoxes (boxlist / Obj)
      (if boxlist
        (foreach pair boxlist ; then
          (setq Obj (CAB:makePline Spc
            (list
              (car pair) (list (caar pair) (cadadr pair))
              (car pair) (list (caadr pair) (cadar pair))
              (cadr pair) (list (caar pair) (cadadr pair))
              (cadr pair) (list (caadr pair) (cadar pair))
            ); list
          );CAB:makePline
          )
        ); foreach
        (prompt "\nMust use GetBoxes first."); else
      ); if
    ); defun
    (setq boxlist (cons (list Pt1 Pt2) boxlist))
    (LM:ActiveSpace 'Doc 'Spc)
    (CW:DrawBoxes boxlist)
  )
 
  (defun CW:GetTableCell (Pt1 / Result Tables ent Table PointOnTable)
    ;Supporting Functions
    ;Routine to output information with some blank lines
    (defun Output (msg)
      (princ "\n")(princ msg)(princ "\n")
    )
   
    (Defun LM: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 ); Grrr1337
      (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
    ;End Supporting Functions
    (setq Tables (Getacadtableobjects))
    (LM:Hittest Pt1 Tables)
  )
 
  ;Debug what is wrong with GetCoordinates
  (defun CW:GetCoordinates (TableInfo *TableUpperLeft *TableLowerRight *RowUpperLeft *RowLowerRight *ColumnUpperLeft *ColumnLowerRight *CellUpperLeft *CellLowerRight / ColumnStartHeight TotalColumnHeight Ct Obj Row Column Rows Columns InsPt ColumnCount RowCount ColumnDistance RowDistance)
    ;Supporting Functions
    (defun d2r (NumberOfDegrees)
      (* pi (/ numberOfDegrees 180.0))
    ) 
    ;End Supporting Functions
    (setq Obj (nth 0 TableInfo)
          Row (nth 1 TableInfo)
          Column (nth 2 TableInfo)
          Rows (vla-get-rows Obj)
          Columns (vla-get-columns Obj)
          InsPt (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint Obj)))
          ColumnCount 0
          RowCount 0
          ColumnDistance 0
          RowDistance 0
          TotalColumnHeight 0
          Ct 2
    )
    (while (< ColumnCount Column)
      (setq ColumnDistance (+ ColumnDistance (vla-getcolumnwidth Obj ColumnCount))
            ColumnCount (+ ColumnCount 1)
      )
    )
    (setq ColumnStartHeight (+ (vla-getrowheight Obj 0) (vla-getrowheight Obj 1)))
    (while (< Ct Rows)
      (setq TotalColumnHeight (+ (vla-getrowheight Obj Ct) TotalColumnHeight)
            Ct (+ ct 1)
      )
    )
    (while (< RowCount Row)
      (setq RowDistance (+ RowDistance (vla-getrowheight Obj RowCount))
            RowCount (+ RowCount 1)
      )
    )
    (set *TableUpperLeft InsPt)
    (set *TableLowerRight (polar (polar InsPt 0 (vla-get-width Obj)) (d2r 270) (vla-get-height Obj)))
    (set *ColumnUpperLeft (polar (polar InsPt 0 ColumnDistance) (d2r 270) ColumnStartHeight))
    (set *ColumnLowerRight (polar (polar (eval *ColumnUpperLeft) 0 (vla-getcolumnwidth Obj Column)) (d2r 270) TotalColumnHeight))
    (set *RowUpperLeft (polar InsPt (d2r 270) RowDistance))
    (set *RowLowerRight (polar (polar (eval *RowUpperLeft) 0 (vla-get-width Obj)) (d2r 270) (vla-getrowheight Obj Row)))
    (set *CellUpperLeft (polar (polar InsPt 0 ColumnDistance) (d2r 270) RowDistance))
    (set *CellLowerRight (polar (polar (eval *CellUpperLeft) 0 (vla-getcolumnwidth Obj Column)) (d2r 270) (vla-getrowheight Obj Row)))
  )
  ;End of Supporting Functions
  (setq Pt1 (getpoint "\nPick point on table: ")
        TableInfo (CW:GetTableCell Pt1)
  )
  (if TableInfo
    (progn
      (cw:GetCoordinates TableInfo 'TableUpperLeft 'TableLowerRight 'RowUpperLeft 'RowLowerRight 'ColumnUpperLeft 'ColumnLowerRight 'CellUpperLeft 'CellLowerRight)
      (initget "ceLl Row Column Table _ceLl Row Column Table")
      (setq Option (getkword "\nTable was detected, select revision cloud method [ceLl/Row/Column/Table]: "))
      (cond
        ((= Option "ceLl")
         (setq Obj (CW:DrawRectangle CellUpperLeft CellLowerRight))
        )
        ((= Option "Row")
         (setq Obj (CW:DrawRectangle RowUpperLeft RowLowerRight))
        )
        ((= Option "Column")
         (setq Obj (cw:DrawRectangle ColumnUpperLeft ColumnLowerRight))
        )
        ((= Option "Table")
         (setq Obj (cw:DrawRectangle TableUpperLeft TableLowerRight))
        )
      )
    )
  )
)