urgent lisp reqd to make table - help

Dear all,

I need a lisp which can write a table of my list values in a specified format.

Yours,

Muthu

I believe more detail is needed. What are these "values"? What "specified format" is required? Why are you being so vague? You do realize that the more information you provide the better you chances of getting some help are, right?

I believe more detail is needed. What are these "values"? What "specified format" is required? Why are you being so vague? You do realize that the more information you provide the better you chances of getting some help are, right?

Please refer attached drawing which will be converted into a table format.

Thank you so much.

sample.dwg

muthu123 not exactly sure what you require however you could try this.

In plain AutoCAD (without any add-ons or vertical flavours) you can use (since the version 2006) the bill-of-materials (parts- or block-list) functionality. Use the attribute extraction tool - EATTEXT (since A2002) or the DATAEXTRACTION wizard.

This command creates a table containing information about the individual references of selected blocks. This table (table object inserted in the drawing) is automatically updated on any change in the drawing (the blocks).

Please refer attached drawing which will be converted into a table format.

 

Thank you so much.

This will get you started, see comments inside the code

(defun make-tablestyle ( name desc txtstyle h1 h2 h3 / tblstyle adoc)
 (or (vl-load-com))
 (setq 
   tblstyle (vla-addobject 
     (vla-item (vla-get-dictionaries 
            (setq adoc (vla-get-activedocument (vlax-get-acad-object))) 
            ) 
          "Acad_Tablestyle" 
          ) 
     name 
     "AcDbTableStyle" 
     ) 
   )
 (setq acmCol (vla-getinterfaceobject
       (vlax-get-acad-object)
       (strcat "AutoCAD.AcCmColor."
        (substr (getvar "ACADVER") 1 2))))  
 (vla-put-name tblstyle name)

 (vla-put-titlesuppressed tblstyle :vlax-true)
 (vla-put-headersuppressed tblstyle :vlax-false) 
 (vla-put-description tblstyle desc) 
 (vla-put-flowdirection tblstyle 0)
 (vla-put-bitflags tblstyle 1)
 (vla-put-horzcellmargin tblstyle 0.25)  
 (vla-put-vertcellmargin tblstyle 0.25)
 (vla-settextstyle tblstyle 7 txtstyle)
 (vla-settextheight tblstyle 1 h3)  
 (vla-settextheight tblstyle 4 h2) 
 (vla-settextheight tblstyle 2 h1) 
 (vla-setrgb acmCol 204 102 0)
;;;  (vla-put-colorindex acmCol 32) 
 (vla-setgridcolor tblstyle 63 7 acmCol)

 (vla-setgridvisibility tblstyle 63 7 :vlax-true) 
 (vla-setgridlineweight  tblstyle 18 7 aclnwt009) 
 (vla-setgridlineweight tblstyle 45 7 aclnwt050) 
 (vlax-release-object acmCol)
 )

;=========== * prepared part for table creation * ===========;
(defun C:BOM (/ acmcol adoc axss cnt col columns dht headers row rows table table_data total)
 (if (< (atof (getvar "ACADVER")) 16.0)
 (alert "This routine will work\nfor versions A2005 and higher")
 (progn 
 (vl-load-com) 
 (or adoc
   (setq adoc (vla-get-activedocument
 (vlax-get-acad-object))))
 (or acsp (setq acsp (if (= (getvar "TILEMODE") 0)
 (vla-get-paperspace
 adoc)
 (vla-get-modelspace
 adoc))
 )
 )
 (make-tablestyle "BOM_table" "BOM table" "ROMANS_S" 3.0 2.25 3.0)
 (setvar "CTABLESTYLE" "BOM_table")
 (setq acmCol (vla-getinterfaceobject
       (vlax-get-acad-object)
       (strcat "AutoCAD.AcCmColor."
        (substr (getvar "ACADVER") 1 2))))
 (setq dht (getvar "dimtxt"));<--text height
 (if (< dht 2.)(setq dht 2.))

[color=red]  ;; add the data list here[/color]

[color=red]  ;; it should look as this list:[/color]

[color=red](setq table_data (list[/color]
[color=red]     '("EP-1" 1 "12X200X350" 6.59)[/color]
[color=red]     '("EP-2" 2 "12X200X350" 6.49)[/color]
[color=red]     '("EP-3" 3 "12X200X350" 6.39)[/color]
[color=red]     '("EP-4" 4 "12X200X350" 6.29)[/color]
[color=red]     '("EP-5" 5 "12X200X350" 6.19)[/color]
[color=red]     '("EP-6" 6 "12X200X350" 6.09))[/color]
[color=red]      )[/color]

(setq total

 (apply '+
 (mapcar '*
  (mapcar 'cadr table_data)
  (mapcar 'last table_data))
 )
     )

(setq columns  (length (car table_data)) 
rows  (length table_data) 
 )
(setq table (vlax-invoke
  acsp
  'Addtable
  (getpoint "\nUpper left table insertion point: \n")
  (+ 2 rows)
  columns
  ;; rows height:
  5.0
  ;; columns width:
  50.0
       )
 )
   (vla-put-titlesuppressed table :vlax-true)
 (vla-put-headersuppressed table :vlax-false)
 (vla-put-regeneratetablesuppressed table :vlax-true)
 (vla-put-layer table "0")
 (vla-put-horzcellmargin table 0.25)
 (vla-put-vertcellmargin table 0.25)

 (vla-settextstyle table 4 "ROMANS_S");<-- text style "ROMANS_S" should be exists
 (vla-settextstyle table 2 "ROMANS_S")
 (vla-settextstyle table 1 "ROMANS_S")
 (vla-setrowheight table 4 (* dht 2))
 (vla-setrowheight table 2 (* dht 1.5))
 (vla-setrowheight table 1 (* dht 2))
 (vla-settextheight table 4 dht)
 (vla-settextheight table 2 (* dht 1.15))
 (vla-settextheight table 1 (* dht 1.5))

 (vla-put-colorindex acmcol 256)
 (vla-put-truecolor table acmcol)

 (vla-setcolumnwidth table 0 37)
 (vla-setcolumnwidth table 1 12)
 (vla-setcolumnwidth table 2 62)
 (vla-setcolumnwidth table 3 24) 
 (vla-put-colorindex acmcol 102)

 (setq headers '("MARK" "QNT" "DESCRIPTION" "WEIGHT"); <-- headers
 )
 (vl-catch-all-apply
     'vlax-invoke (list table 'UnMergeCells 0 0 0 (1- columns)); <-- unmerge cells
   )
 (setq col 0
row 0
 )
 (foreach a headers
   (vla-setcellvalue table row col a)
   (vla-setrowheight table 0 
   (vla-setcelltextheight table row col (* dht 1.5))
   (vla-setcellcontentcolor table row col acmcol)
   (setq col (1+ col))
 )
(vla-put-colorindex acmcol 182)  
 (setq cnt 0 row 1)
 (foreach i table_data
   (vla-setrowheight table cnt 5)
 (setq col 0)
 (foreach a i
   (vla-setcellvalue table row col a)
   (vla-setcelltextheight table row col (* dht 1.5))
   (cond ((/= col 3)
   (progn
   (vla-setcelldatatype table row col acstring acunitless)
          (vla-setcellformat  table row col "@")));<-- text format
  (T (progn(vla-setcelldatatype table row col acdouble acunitless)
          (vla-setcellformat  table row col "%lu2%pr2%th44"));<-- double with 2 decimals,dot separated
  ))

   (vla-setcellalignment table row col acMiddleCenter)
   (vla-setcellcontentcolor table row col acmcol)
   (setq col (1+ col)))
   (setq row (1+ row))
   )
   (vl-catch-all-apply
     'vlax-invoke (list table 'MergeCells row row 0 (- columns 2));<--merge cells
   )
 (vla-put-colorindex acmcol 12)
 (vla-setrowheight table row 5)
 (vla-setcelltextheight table row 0 (* dht 1.5))
 (vla-settext table row 0 "Total:\t")
 (vla-setcellalignment table row 0 acMiddleRight)
 (vla-setcellcontentcolor table row 0 acmcol)
 (vla-setcellvalue table row (1- columns) total)
 (vla-setcelldatatype table row (1- columns) acdouble acunitless)
 (vla-setcellformat  table row (1- columns) "%lu2%pr2%th44" );<-- double with 2 decimals,dot separated

 (vla-settooltip table row (1- columns) "Total Weight")
 (vla-setcelltextheight table row (1- columns) (* dht 1.5))
 (vla-setcellalignment table row (1- columns) acMiddleCenter)
 (vla-setcellcontentcolor table row (1- columns) acmcol)
 (vla-generatelayout table)
 (vla-recomputetableblock table :vlax-true)
 (vla-put-regeneratetablesuppressed table :vlax-false)

 (vl-catch-all-apply
   (function
     (lambda ()
(progn
  (vla-clear axss)
  (vla-delete axss)
  (mapcar 'vlax-release-object (list axss table))
  )
)
     )
   )
 (vla-regen adoc acactiveviewport)
 )
   )
 (princ)
)
(prompt
 "\n\t\t\t   |-----------------------------|\n"
)
(prompt
 "\n\t\t\t  <|  Start with BOM to execute  |>\n"
)
(prompt
 "\n\t\t\t   |-----------------------------|\n"
)
(prin1)
(vl-load-com)

~'J'~

Dear fixo,

Thank you so much for your great effort.

But the Program is breaking with this error

error: Automation Error. Key not found

at (vla-settextstyle tblstyle 7 txtstyle).

If you can, Please let me know what is the error and how to correct it?

Yours

MUTHU.

Dear fixo,

 

Thank you so much for your great effort.

But the Program is breaking with this error

error: Automation Error. Key not found

at (vla-settextstyle tblstyle 7 txtstyle).

 

If you can, Please let me know what is the error and how to correct it?

 

Yours

MUTHU.

I tested this code on your attached sample drawing from there:

http://www.cadtutor.net/forum/showpost.php?p=323201&postcount=3

It's working good for me (I use A2008 )

My guess is you executed this code on drawing that has not

text style "ROMANS_S"

Change on appropriate text style name

~'J'~

Ok.yes.Now it is clear.

But it is telling now the following error.

; error: no function definition: VLA-SETTOOLTIP.

IS this your own fucntion?

Ok.yes.Now it is clear.

 

But it is telling now the following error.

; error: no function definition: VLA-SETTOOLTIP.

 

IS this your own fucntion?

Just remove this code line from there

and try again

~'J'~

Just remove this code line from there

and try again

 

~'J'~

Thank you so much.

Now it is working nice.

Yours

Muthu.

Thank you so much.

 

Now it is working nice.

 

Yours

Muthu.

You're welcome

Cheers

~'J'~

Please read the CODE POSTING GUIDELINES and edit your post to include Code Tags.

Fixo,

I was reviewing some of your lisp and I combined into the lisp below that satified to a certain point what I am trying to do. I was woundering how can I make the table to show me totals, and if is possible how can I add another column (column F) that adds column C with column D or does other mathematical operations.

I admire your work,

Sincerely,

PC

I apologize for any inconvenience SLW210.

---

(defun C:SUPERDATA(/  acsp adoc atable attdata attitem atts blkdata blkname blkobj col datalist
   en headers pt row sset tabledata tags total txtheight x)
 
 ;local defun

 (defun sum-and-groupby-all (lst / groups res sum tmp)
 (while lst
   (setq tmp     (car lst)
  sum
     (apply '+ 
     (mapcar 'car 
      (setq res (vl-remove-if-not
           '(lambda (a) (vl-every 'eq a tmp))
           lst
         )
      )
         ) 
      )
  groups    (cons (subst (itoa sum) (car tmp) tmp) groups)
  lst
     (vl-remove-if
       '(lambda (a) (member a res))
       lst
     )
   )
 )

(reverse groups)
)
 

;main part
 (if (setq sset (ssget (list (cons 0 "INSERT") (cons 66 1))))
   (progn
     (setq tabledata nil
    attdata nil
    attitem nil
     )
     (setq headers (list "COUNT" "BLKNAME" "ATT1" "ATT2" "ATTNAME")
    tags    (cddr headers)
     )
     (while (setq en (ssname sset 0))
(setq blkobj  (vlax-ename->vla-object en)
      blkname (vla-get-effectivename blkobj)
)
(setq atts (vlax-invoke blkobj 'getattributes))
(foreach attobj atts
  (if (member (vla-get-tagstring attobj) tags)
    (progn
      (setq attitem (cons (vla-get-tagstring attobj) (vla-get-textstring attobj)))
      (setq attdata (cons attitem attdata))
    )
  )
)
(setq blkdata (append (list 1 blkname) (reverse attdata)))
(setq tabledata (cons blkdata tabledata))
(setq attdata nil
      attitem nil
)
(ssdel en sset)
     )
     (setq tabledata (mapcar '(lambda (x)
    (append (list (car x) (cadr x))
     (mapcar 'cdr (cddr x))
    )
         ) 
        tabledata
       )
     )
     (setq tabledata (sum-and-groupby-all tabledata ))

     ;; sort by "PART-REF"
     (setq total 0)
     (foreach i datalist (setq total (+ total (cdr i))))
   (initget 6)
 (setq txtheight (getreal "\nSpecify Text height for the table <50>:"))
 (cond ((not txtheight)(setq txtheight 50))) ;<-- text height as for as in your drawing
      (or adoc (setq adoc (vla-get-activedocument (setq acapp (vlax-get-acad-object)))))
     (or acsp (setq acsp (vla-get-block (vla-get-activelayout adoc))))
(setq acCol (vla-GetInterfaceObject acapp(strcat "AutoCAD.AcCmColor." (itoa(atoi(getvar "acadver"))))))
     (setq pt (getpoint "\nSpecify table location:"))
     (setq atable (vla-addtable
      acsp
      (vlax-3d-point pt)
      (+ 2 (length tabledata))
      (length headers)
      (* txtheight 1.2)
      (* txtheight 20)
    )
     )
     (vla-put-regeneratetablesuppressed atable :vlax-true)
      ; calculate column widths
     (setq swap (append (list headers) tabledata)
    widths nil)
     (while (car swap)
(setq column (mapcar 'car swap))
(setq colwidth (* 1.2 (apply 'max (mapcar 'strlen column))txtheight))
(setq widths (cons colwidth widths))
(setq swap (mapcar 'cdr swap)))
     (setq widths (reverse widths))
      ; set column widths
   (setq col 0)
   (foreach wid widths
     (vla-setcolumnwidth atable col wid)
     (setq col (1+ col))
     )
     (vla-put-horzcellmargin atable (* txtheight 0.5))
     (vla-put-vertcellmargin atable (* txtheight 0.3))
     (vla-setTextheight atable 1 txtheight)
     (vla-setTextheight atable 2 txtheight)
     (vla-setTextheight atable 4 txtheight)
     (vla-setText atable 0 0 "SUMMARY")
     (vla-SetCellAlignment atable 0 0 acMiddleCenter)
           (vla-put-colorindex accol 1)
(vla-setcellcontentcolor atable 0 0 accol)
     (setq col -1)
     (foreach descr headers
(vla-setText atable 1 (setq col (1+ col)) descr)
(vla-SetCellAlignment atable 1 col acMiddleCenter)
(vla-setcellcontentcolor atable 1 col accol)
     )
     
       (vla-put-colorindex accol 5)
     
      (setq row 2)
     
     (foreach record tabledata
(setq col 0)
(foreach item record
  (vla-setText atable row col item)
  (if (= 1 col)
  (vla-SetCellAlignment atable row col acMiddleCenter)
  (vla-SetCellAlignment atable row col acMiddleLeft)
          )
  (vla-setcellcontentcolor atable row col accol)
  (setq col (1+ col))
)
(setq row (1+ row))
     )
(vla-put-width atable (apply '+ widths))
     (vla-put-height atable (* 1.2 (vla-get-rows atable)txtheight))
     (vla-put-regeneratetablesuppressed atable :vlax-false)
   )
 )
(if  accol (vlax-release-object accol))
(if  acapp (vlax-release-object acapp))
(princ)
)
(prompt "\n\t---\tStart command with superdata\t---\n")
(prin1)
(or (vl-load-com))
(princ)