How do you fill a table with a color

[jeffl]

I've created a lsp routine which creates a table and in one column I need to apply a fill color (background fill) to the cell. I have the color which should be applied to the cell. Currently it's just inserting the stored value in the format of 14 0 81 10485632, so the color I want to assign to the cell would be 81 (3rd value from left).  This is what the table looks like, so it would be for column 0 

 

 

I have everything else working great, just cant figure out how to change this so it fills with a color instead of populating it with the actual stored value. Here's the snippet of code which is used to fill columns 0,1,2

 

    (setq rsid (AfmRsOpen SQLQuery)) ; Open record set for primary owner
        (while (not (AfmRsEOF rsid)) ; start loop for primary owner data
            (setq HpAcad (AfmRsGetStr rsid 0))
            (setq buCode (AfmRsGetStr rsid 1))
            (setq BuName (AfmRsGetStr rsid 2))
            (setq lstOfSublist (list (list HpAcad buCode BuName )))
                (foreach lstSublist lstOfSublist
                    (foreach strItem lstSublist
                        (vla-settext objtable intRow intColumn strItem)
                            (setq intColumn (1+ intColumn))
                    )
                )

 

The field is populated with HpAcad from above.

 

I'll also post the actual file, this is my first attempt at using tables and I'm not much of a lsp writer to start with, so please excuse formatting for those detail oriented folks. Also please understand that you cant test the code do the system this was written for is specific to this application.

 

Thanks

HighxOwner.lsp

[dlanorh]

It would appear that you are setting the cell text to the color value

 

You need to use the SetCellbackgroundColor method

either (vla-setcellbackgroundcolor table_obj row col color)
    or (vlax-invoke-method table_obj 'setcellbackgroundcolor row col color)

 

This may involve having to get the correct AutoCAD Color Interface Object for your version

 

Example

Method Page

Google

[jeffl]

On 1/22/2019 at 3:01 PM, dlanorh said:

 

either (vla-setcellbackgroundcolor table_obj row col color)
    or (vlax-invoke-method table_obj 'setcellbackgroundcolor row col color)

 

Thanks dlanorh, I'll give this a try. Sorry for the late response I only work on this on this once a week.

 

 

 

[jeffl]

OK, so I've tried numerous ways to accomplish this with no success. What am I doing wrong in setting the color. So I'm passing in a color number in the strItem (lets call it 30) but it's not recognizing the value:

 

    (setq rsid (AfmRsOpen SQLQuery)) ; Open record set for primary owner
        (while (not (AfmRsEOF rsid)) ; start loop for primary owner data
            (setq HpAcad (AfmRsGetStr rsid 0))
            (setq buCode (AfmRsGetStr rsid 1))
            (setq BuName (AfmRsGetStr rsid 2))
            (setq listResult (AfmHighlightSupStrToList HpAcad))
            (setq strRet (nth 2 listResult))
            ;(print strRet)
            (setq lstOfSublist (list (list strRet )))
                (foreach lstSublist lstOfSublist
                    (foreach strItem lstSublist
                            (setq clr (vlax-create-object "AutoCAD.AcCmColor"))
                            (vla-put-colorindex clr strItem)
                            (vla-SetCellBackgroundColor objtable intRow intColumn clr)
                            ;(vla-settext objtable intRow intColumn strItem)
                            ;(setq intColumn (1+ intColumn))
    
                    )
                )

 

If if I hard corded the value ( (vla-put-colorindex clr 30) I still get this error:

 

error: bad argument type: VLA-OBJECT nil. I'm new to this so a little frustrating to say the least.

 

Thanks

[jeffl]

Also if I put the variable into the SetCellBackgroundColor (vla-SetCellBackgroundColor objtable intRow intColumn strItem) I get this error:

 

error: lisp value has no coercion to VARIANT with this 
type:  "30"

 

 

[Lee Mac]

Here is a quick example to point you in the right direction -

(defun c:setcellcolour ( / acm col obj row sel )
    (cond
        (   (not
                (and
                    (princ "\nSelect table: ")
                    (setq sel (ssget "_+.:E:S:L" '((0 . "ACAD_TABLE"))))
                    (setq col (acad_colordlg 1 nil))
                )
            )
        )
        (   (not
                (setq acm
                    (vla-getinterfaceobject
                        (vlax-get-acad-object)
                        (strcat "autocad.accmcolor." (substr (getvar 'acadver) 1 2))
                    )
                )
            )
            (princ "\nUnable to interface with AcCmColor object.")
        )
        (   (setq obj (vlax-ename->vla-object (ssname sel 0)))
            (vla-put-colorindex acm col)
            (vla-put-regeneratetablesuppressed obj :vlax-true)
            (repeat (setq row (vla-get-rows obj))
                (setq row (1- row))
                (repeat (setq col (vla-get-columns obj))
                    (vla-setcellbackgroundcolor obj row (setq col (1- col)) acm)
                )
            )
            (vla-put-regeneratetablesuppressed obj :vlax-false)
            (vlax-release-object acm)
        )
    )
    (princ)
)
(vl-load-com) (princ)

 

Edited February 5, 2019 by Lee Mac

[jeffl]

Thanks Lee, I'll see what I can decipher from this. 

[Grrr]

Hi Lee,

I remember your post from here about obtaining the AcCmColor object,  then in this case  would it behave in the same way -

(setq acm (vla-get-TrueColor (vlax-ename->vla-object (ssname sel 0))))

Instead of creating an instance of it, like its normally accepted -

(setq acm
  (vla-getinterfaceobject
    (vlax-get-acad-object)
    (strcat "autocad.accmcolor." (substr (getvar 'acadver) 1 2))
  )
)

 

[Lee Mac]

1 minute ago, Grrr said:

I remember your post from here about obtaining the AcCmColor object,  then in this case  would it behave in the same way...

 

Indeed, that's also an alternative

[jeffl]

I think you gentlemen for the responses, I have everything working now. Really appreciate the assistance which you provided.

Edited February 12, 2019 by jeffl

[Lee Mac]

You're welcome Jeff