Extraction to a Table Help

3arizona · ‎06-14-2019

I've been searching for this lisp for awhile and just found it on another thread. Can someone help me to modify it?

Lisp works well as it is, the only changes i a want to make are:

An option to WINDOW or select ALL
Insert a table location. Something like this: (defun insert_table (lst pct / tab row col ht i n space)
If 2 is too complicated i'd be happy with 1 option

;| http://www.cadtutor.net/forum/showthread.php?83991-Populate-Table
 Original by Oleg Fateev

 Modified by hms 2014/11/14
 as a 'demo' to JCprog
 http://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/extract-attributes-from-a-specific-block-and-write-to-table/m-p/5399759#U5399759
|; 
(defun C:CLIST (/ a1 a2 a3 acapp acsp adoc atable attdata atts col headers pt row title)
  (or adoc
      (setq adoc (vla-get-activedocument (setq acapp (vlax-get-acad-object))))
  )
  (or acsp
      (setq acsp (vla-get-block (vla-get-activelayout adoc)))
  )

  (vlax-for blk (vla-get-blocks adoc)
    (if (= (vla-get-IsXref blk) :vlax-true)
      (vlax-for x blk
        (if (and (= (vla-get-ObjectName x) "AcDbBlockReference")
                 (wcmatch (vla-get-EffectiveName x) "*|blk01")
            )
          (progn
            (setq atts (vlax-invoke x 'getattributes))
            (foreach att atts
              (cond ((wcmatch (vla-get-tagstring att) "tag01")
                     (setq a1 (vla-get-textstring att))
                    )
                    ((wcmatch (vla-get-tagstring att) "tag02")
                     (setq a2 (vla-get-textstring att))
                    )
                    ((wcmatch (vla-get-tagstring att) "tag03")
                     (setq a3 (vla-get-textstring att))
                    )
              )
            )
            (setq attdata (cons (list a1 a2 a3) attdata))
          )
        )
      )
    )
  )
  (if (setq pt (getpoint "\nSpecify table location:"))
    (progn
      (setq atable
             (vla-addtable
               acsp
               (vlax-3d-point pt)
               (+ 2 (length attdata))
               3
               (/ (getvar 'dimtxt) 2)
               (* (getvar 'dimtxt) 4)
             )
      )
      (vla-put-regeneratetablesuppressed atable :vlax-true)
      (setq col 0)
      (foreach wid (list 10.0 10.0)
        (vla-setcolumnwidth atable col wid)
        (setq col (1+ col))
      )
      (vla-put-horzcellmargin atable 0.3)
      (vla-put-vertcellmargin atable 0.3)
      (vla-setTextheight atable 1 2.0)
      (vla-setTextheight atable 2 1.4)
      (vla-setTextheight atable 4 1.4)
      (setq title "Demo")
      (vla-setText atable 0 0 title)
      (vla-setcelltextheight atable 0 0 2.0)
      (vla-SetCellAlignment atable 0 0 acMiddleCenter)
      (setq headers (list "Tag01" "Tag02" "Tag03"))
      (setq row 1
            col 0
      )
      (repeat (length headers)
        (vla-SetCellAlignment atable row col acMiddleCenter)
        (vla-setcelltextheight atable row col 1.4)
        (vla-setText atable row col (car headers))
        (setq headers (cdr headers))
        (setq col (1+ col))
      )
      (setq row 2)
      (foreach record attdata
        (setq col 0)
        (foreach item record
          (vla-setText atable row col item)
          (vla-SetCellAlignment atable row col acMiddleCenter)
          (vla-setcelltextheight atable row col 1.4)
          (setq col (1+ col))
        )
        (setq row (1+ row))
      )
      (vla-put-regeneratetablesuppressed atable :vlax-false)
      (vla-put-height atable (+ (* (vla-get-rows atable) 2.2) 4.1))
      (vla-update atable)
    )
  )
  (princ)
)
(prompt "\n\t---\tStart command with CLIST\t---\n")
(prin1)
(or (vl-load-com))
(princ)

Thanks

Moshe-A · ‎06-14-2019

@3arizona hi,

post a sample dwg so we can run this lisp.

moshe

3arizona · ‎06-17-2019

moshe,

Sorry it too so long to reply. I copied the tag so that i can post the drawing and now i cant get the lisp to extract anything. Lisp only works on my original drawing and it's too big to post. i've tried to save-as and remove all line work also copy and paste to a new drawing without any luck. Attached is a copy of the tag drawing and maybe you or someone else can help me figure this out.

I though i had finally found the lisp i was looking for.

devitg · ‎06-17-2019

I though i had finally found the lisp i was looking for.

Please show us, it.

devitg · ‎06-17-2019

Please , clear it.

the block it is not an Xref

(= (vla-get-IsXref blk) :vlax-true)

It give :vlax-false

Moshe-A · ‎06-17-2019

@3arizona hi,

the lisp you found does not do what you want, instead i suggest you to explore DATAEXTRACTION command.

moshe

3arizona · ‎06-17-2019

devitg,

"Clear it" does it equal delete? : (= (vla-get-IsXref blk) :vlax-true)

If i delete this line i get a syntax error.

sorry, not too proficient with lisps

devitg · ‎06-17-2019

Find attached the way I get to work

The original LISP , is from my very good FRIEND . Oleg Fateev , sad to say he passed away a few years ago .

He honour me at the cadtutor

https://www.cadtutor.net/forum/topic/48890-rectangle-lisplittle-help/page/2/?tab=comments#comment-40...

See he show my country flag , when the Football world champion at Russia

He teach me a about 50 % of my lisp proficience {

3arizona · ‎06-17-2019

Is there a way to change from selecting ALL to window a few objects?

Thank you very much and sorry to hear bout your friend. He's still helping others!!

devitg · ‎06-17-2019

Please upload your DWG .

When one do not want , two can not do.

Put some from you .

Last time you put only one block

This lisp look for all the blockreference named blk01.

3arizona · ‎06-17-2019

Sorry, lisp works perfect!!! At the moment lisp is searching entire drawing. i want an option to window a portion of the drawing or select all

devitg · ‎06-17-2019

Please upload your DWG .

Or send me to my email. it is myusernamehere at gmail.com

3arizona · ‎06-17-2019

it's the same drawing i posted with the tag. I want to be able to select 1 or 2 tags

devitg · ‎06-17-2019

Sorry, no pain , no gain,

3arizona · ‎06-18-2019

hmsilva,

Can you help me finish this lisp? i believe your familiar with it. I want to be able to select/window a portion of the blocks not ALL, as it currently does.

thank you all for your time.

Sea-Haven · ‎06-18-2019

This may be usefull it uses a block in layouts but could be changed to a selection but is a complete example of multi blocks to table.

3arizona · ‎06-25-2019

Can someone can help me change this lisp provided by DEVITG? At the moment lisp is selecting ALL blocks and i want to WINDOW a few of them. I've tried a few thing that i know but cant figure i out.

Thanks

;| http://www.cadtutor.net/forum/showthread.php?83991-Populate-Table
 Original by Oleg Fateev

 Modified by hms 2014/11/14
 as a 'demo' to JCprog
 http://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/extract-attributes-from-a-specific-block-and-write-to-table/m-p/5399759#U5399759
modified by
;; Design by Gabo CALOS DE VIT from CORDOBA ARGENTINA
;;;    Copyleft 1995-2019 by Gabriel Calos De Vit ; DEVITG@GMAIL.COM    
;;
In honor  to by BIG FRIEND Oleg Fateev , aka OLD HORSE , from Saint Petersburg Russia
Sad to say he passed away a few years ago
 
|; 
(defun C:CLIST (/ a1 a2 a3 acapp acsp adoc atable attdata atts col headers pt row title)
  (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 blk (vlax-ename->vla-object (car (entsel))))

;;;(setq x blk)
;;;  (setq attdata nil)
  
  (vlax-for blk (vla-get-blocks adoc)
    (if blk
      (vlax-for x blk
        (if (and (= (vla-get-ObjectName x) "AcDbBlockReference")
                 (wcmatch (vla-get-EffectiveName x) "*blk01");;  *blk01 instead *|blk01
            )
          (progn
            (setq atts (vlax-invoke x 'getattributes))
            (setq att (nth 0 atts))
            (foreach att atts
              (cond ((wcmatch (vla-get-tagstring att) "TAG01")
                     (setq a1 (vla-get-textstring att))
                    )
                    ((wcmatch (vla-get-tagstring att) "TAG02")
                     (setq a2 (vla-get-textstring att))
                    )
                    ((wcmatch (vla-get-tagstring att) "TAG03")
                     (setq a3 (vla-get-textstring att))
                    )
              )
            )
            (setq attdata (cons (list a1 a2 a3) attdata))
          )
        )
      );vlax-for 
    ); if blok 
  ); vlax-for blk at blk collection
  (if (setq pt (getpoint "\nSpecify table location:"))
    (progn
      (setq atable
             (vla-addtable
               acsp
               (vlax-3d-point pt)
               (+ 2 (length attdata))
               3
               (/ (getvar 'dimtxt) 2)
               (* (getvar 'dimtxt) 4)
             )
      )
      (vla-put-regeneratetablesuppressed atable :vlax-true)
      (setq col 0)
      (foreach wid (list 10.0 10.0)
        (vla-setcolumnwidth atable col wid)
        (setq col (1+ col))
      )
      (vla-put-horzcellmargin atable 0.3)
      (vla-put-vertcellmargin atable 0.3)
      (vla-setTextheight atable 1 2.0)
      (vla-setTextheight atable 2 1.4)
      (vla-setTextheight atable 4 1.4)
      (setq title "Demo")
      (vla-setText atable 0 0 title)
      (vla-setcelltextheight atable 0 0 2.0)
      (vla-SetCellAlignment atable 0 0 acMiddleCenter)
      (setq headers (list "Tag01" "Tag02" "Tag03"))
      (setq row 1
            col 0
      )
      (repeat (length headers)
        (vla-SetCellAlignment atable row col acMiddleCenter)
        (vla-setcelltextheight atable row col 1.4)
        (vla-setText atable row col (car headers))
        (setq headers (cdr headers))
        (setq col (1+ col))
      )
      (setq row 2)
      (foreach record attdata
        (setq col 0)
        (foreach item record
          (vla-setText atable row col item)
          (vla-SetCellAlignment atable row col acMiddleCenter)
          (vla-setcelltextheight atable row col 1.4)
          (setq col (1+ col))
        )
        (setq row (1+ row))
      )
      (vla-put-regeneratetablesuppressed atable :vlax-false)
      (vla-put-height atable (+ (* (vla-get-rows atable) 2.2) 4.1))
      (vla-update atable)
    )
  )
  (princ)
)
(prompt "\n\t---\tStart command with CLIST\t---\n")
(prin1)
(or (vl-load-com))
(princ)

hmsilva · ‎06-26-2019

Modified...

;| http://www.cadtutor.net/forum/showthread.php?83991-Populate-Table
 Original by Oleg Fateev

 Modified by hms 2019/06/26
 as a 'demo' to 3arizona
https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/extraction-to-a-table-help/m-p/8852571#M386385
|;
(defun C:CLIST (/      a1     a2     a3	    acapp  acsp	  adoc	 atable
		attdata	      atts   col    headers	  i	 pt
		row    ss     title  x
	       )
  (or adoc
      (setq adoc (vla-get-activedocument (setq acapp (vlax-get-acad-object))))
  )
  (or acsp
      (setq acsp (vla-get-block (vla-get-activelayout adoc)))
  )

  (prompt "\nSelect blocks blk01 to make a Table:  ")
  (if
    (setq ss (ssget (list '(0 . "insert") '(66 . 1) (cons 2 "*blk01,`*U*"))))
     (repeat (setq i (sslength ss))
       (setq x (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
       (if (wcmatch (vla-get-EffectiveName x) "*blk01")
	 (progn
	   (setq atts (vlax-invoke x 'getattributes))
	   (foreach att	atts
	     (cond ((wcmatch (vla-get-tagstring att) "TAG01")
		    (setq a1 (vla-get-textstring att))
		   )
		   ((wcmatch (vla-get-tagstring att) "TAG02")
		    (setq a2 (vla-get-textstring att))
		   )
		   ((wcmatch (vla-get-tagstring att) "TAG03")
		    (setq a3 (vla-get-textstring att))
		   )
	     )
	   )
	   (setq attdata (cons (list a1 a2 a3) attdata))
	 )
       )
     )
  )
  (if (setq pt (getpoint "\nSpecify table location:"))
    (progn
      (setq atable
	     (vla-addtable
	       acsp
	       (vlax-3d-point pt)
	       (+ 2 (length attdata))
	       3
	       (/ (getvar 'dimtxt) 2)
	       (* (getvar 'dimtxt) 4)
	     )
      )
      (vla-put-regeneratetablesuppressed atable :vlax-true)
      (setq col 0)
      (foreach wid (list 10.0 10.0)
	(vla-setcolumnwidth atable col wid)
	(setq col (1+ col))
      )
      (vla-put-horzcellmargin atable 0.3)
      (vla-put-vertcellmargin atable 0.3)
      (vla-setTextheight atable 1 2.0)
      (vla-setTextheight atable 2 1.4)
      (vla-setTextheight atable 4 1.4)
      (setq title "Demo")
      (vla-setText atable 0 0 title)
      (vla-setcelltextheight atable 0 0 2.0)
      (vla-SetCellAlignment atable 0 0 acMiddleCenter)
      (setq headers (list "Tag01" "Tag02" "Tag03"))
      (setq row	1
	    col	0
      )
      (repeat (length headers)
	(vla-SetCellAlignment atable row col acMiddleCenter)
	(vla-setcelltextheight atable row col 1.4)
	(vla-setText atable row col (car headers))
	(setq headers (cdr headers))
	(setq col (1+ col))
      )
      (setq row 2)
      (foreach record attdata
	(setq col 0)
	(foreach item record
	  (vla-setText atable row col item)
	  (vla-SetCellAlignment atable row col acMiddleCenter)
	  (vla-setcelltextheight atable row col 1.4)
	  (setq col (1+ col))
	)
	(setq row (1+ row))
      )
      (vla-put-regeneratetablesuppressed atable :vlax-false)
      (vla-put-height atable (+ (* (vla-get-rows atable) 2.2) 4.1))
      (vla-update atable)
    )
  )
  (princ)
)
(prompt "\n\t---\tStart command with CLIST\t---\n")
(prin1)
(or (vl-load-com))
(princ)

Hope this helps,
Henrique

3arizona · ‎06-26-2019

hmsilva,

Works Perfect!!!!!! Thank you all for your help and time

hmsilva · ‎06-26-2019

@3arizona wrote:

hmsilva,

Works Perfect!!!!!! Thank you all for your help and time

You're welcome, 3arizona
Glad I could help

Henrique

Community

Extraction to a Table Help

Extraction to a Table Help

Extraction to a Table Help