Quantcast
Channel: Autodesk AutoCAD forums
Viewing all articles
Browse latest Browse all 14319

Set table cell background color

$
0
0

WIth the help of many of you here I have created subroutines to build tables in AutoCAD.

What I would like to do is to is if a value in the table list (example a question mark), then make the background color of that cell color 1 (red).

 

List to insert as a table -

(setq List_Table (list (list "A" "?" "C" "D" "E") (list "11" "12" "13" "14" "15") (list "21" "22" "23" "24" "25")))

(Build_Table "Title" List_Table 3 5 0.1 1)

 

Here are the subroutines -

(defun Build_Table (TableName List_Table NumRows NumColumns RowHeight ColWidth /); P0 Table_Obj KW KK KT KL Blocks_Obj Block_Obj Block_Id)
  ;--set table scale-------------------------------------
  (setq Dscale 1.0)
  ;--get location----------------------------------------
  (setq P0 (vlax-3d-point (getpoint (strcat "\nPick Location for " TableName " List ? "))))
  ;--create table object---------------------------------
  (setq Table_Obj (setq Table_Obj (Table_Make "MODEL" P0 (+ 2 NumRows) NumColumns RowHeight ColWidth Default_TextStyle)))
  ;--supress reneration----------------------------------
  (vla-put-RegenerateTableSuppressed Table_Obj :vlax-true)
  ;--set table header text, text size & row height-------
  (vla-settext Table_Obj 0 0 TableName)
  (vla-setcelltextheight Table_Obj 0 0 (* 0.15 Dscale))
  (vla-setrowheight Table_Obj 0 (* 0.3 Dscale))
  (vla-setrowheight Table_Obj 1 (* 0.5 Dscale))
  ;--set table column widths all other columns-----------
 
  (vla-setcolumnwidth Table_Obj 0 (* 1.5  Dscale))
  (vla-setcolumnwidth Table_Obj 1 (* 1.5  Dscale))
  (vla-setcolumnwidth Table_Obj 2 (* 1.5  Dscale))
  (vla-setcolumnwidth Table_Obj 3 (* 1.5  Dscale))
  (vla-setcolumnwidth Table_Obj 4 (* 1.5  Dscale))
  ;--set header text-------------------------------------
 
  (vla-settext Table_Obj 1 0 "Column 1")
  (vla-settext Table_Obj 1 1 "Column 2")
  (vla-settext Table_Obj 1 2 "Column 3")
  (vla-settext Table_Obj 1 3 "Column 4")
  (vla-settext Table_Obj 1 4 "Column 5")
  ;--set header text alignment and text size-------------
  (setq KK 1)
  (while (< KK (+ 2 (length List_Table)))
    (setq KT 0)
    (while (< KT 5)
      (vla-SetCellAlignment  Table_Obj KK KT acMiddleCenter)
      (vla-setcelltextheight Table_Obj KK KT (* 0.1 Dscale))
      (vlax-invoke-method Table_Obj 'SetMargin KK KT 1 (* 0.05 Dscale))
      (vlax-invoke-method Table_Obj 'SetMargin KK KT 2 (* 0.03 Dscale))
      (setq KT (1+ KT))
    )
    (vlax-invoke-method Table_Obj 'SetMargin KK 0 1 (* 0.05 Dscale))
    (vlax-invoke-method Table_Obj 'SetMargin KK 0 2 (* 0.03 Dscale))
    (setq KK (1+ KK))
  )
  ;--update cell text, height, alignment, margins--------
  (setq KK 0)
  (while (< KK NumRows);(< KK (1- NumRows))
    (vla-settext Table_Obj (+ 2 KK) 0 (nth 0 (nth KK List_Table)))
    (vla-settext Table_Obj (+ 2 KK) 1 (nth 1 (nth KK List_Table)))
    (vla-settext Table_Obj (+ 2 KK) 2 (nth 2 (nth KK List_Table)))
    (vla-settext Table_Obj (+ 2 KK) 3 (nth 3 (nth KK List_Table)))
    (vla-settext Table_Obj (+ 2 KK) 4 (nth 4 (nth KK List_Table)))
    (setq KK (1+ KK))
  )
  ;--turn table regeneration on--------------------------
  (vla-put-RegenerateTableSuppressed Table_Obj :vlax-false)
  (princ)
)

(defun Table_Make (ASpace InsertionPoint NumRows NumColumns RowHeight ColWidth TableStyle / objDoc objASpace objTable Tdata)
  (if (listp InsertionPoint)
    (setq InsertionPoint (vlax-3d-point InsertionPoint))
  )
  (if (vl-catch-all-error-p
        (progn
          (setq objDoc (vla-get-activedocument (vlax-get-acad-object)))
          (if (= Aspace "MODEL")
            (setq objASpace (vla-get-modelspace objDoc))
            (setq objASpace (vla-get-paperspace objDoc))
          )
          (setq objTable (vl-catch-all-apply 'vla-addtable (list objASpace InsertionPoint NumRows NumColumns RowHeight ColWidth)))
        )
      )
    (progn
      (setq Tdata nil)
    )
    (progn
      (vl-catch-all-apply 'vla-put-stylename (list objTable TableStyle))
      (setq Tdata objTable)
    )
  )
  objTable
)


Viewing all articles
Browse latest Browse all 14319

Trending Articles