Populate Table

[Luís Augusto]

Hello everybody.

Anyone know of a routine capable of popular tables with attributes?

The table style already exists in the template, I wonder if there is any routine can select a block with attributes and insert filled with tags that start with "PIN_" table here in the forum.

Researched many things related to extraction of attributes but nothing that could change to my need.

If you know of something that can help me, I'd be grateful.

I took the liberty of attaching an example to make it clearer.

Great all year.

 

Populate table.dwg

 

Translated by Google

[BIGAL]

This is a dwg index lisp and makes a table it could be changed to only a single block pick.

 

; dwg index to a table
; by Alan H NOV 2013
(defun AH:dwgindex (/ doc objtable ss1 lay ans ans2 plotabs ss1 tag2 tag3 list1 list2 curlayout colwidth numcolumns numrows INC rowheight )
(vl-load-com)
(setq curlayout (getvar "ctab"))
(if (= curlayout "Model")
(progn
(Alert "You need to be in a layout for this option")
(exit)
) ; end progn
) ; end if model
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(setq curspace (vla-get-paperspace doc))
(setq pt1 (vlax-3d-point (getpoint "\nPick point for top left hand of table:  "))) 
; read values from title blocks
(setq bname "DA1DRTXT")
(setq tag2 "DRG_NO") ;attribute tag name
(setq tag3 "WORKS_DESCRIPTION") ;attribute tag name
(setq ss1 (ssget "x"  (list (cons 0 "INSERT") (cons 2 bname))))
(if (= ss1 nil) ; for tomkinson jobs
(progn 
(setq bname "COGG_TITLE")
(setq ss1 (ssget "x"  (list (cons 0 "INSERT") (cons 2 bname))))
)
)
(setq INC (sslength ss1))  
(repeat INC
(foreach att (vlax-invoke (vlax-ename->vla-object (ssname SS1 (SETQ INC (- INC 1)) )) 'getattributes) 
       (if (= tag2 (strcase (vla-get-tagstring att)))
           (progn
           (setq ans (vla-get-textstring att))
           (if (/= ans NIL)
           (setq list1 (cons ans list1))
           ) ; if 
           ); end progn
         ) ; end if
       (if (= tag3 (strcase (vla-get-tagstring att)))
         (progn
         (setq ans2 (vla-get-textstring att))
         (if (/= ans2 NIL)
             (setq list2 (cons ans2 list2)) 
          ) ; end if
          ) ; end progn
 ) ; end if tag3 
   
) ; end foreach
) ; end repeat
(setvar 'ctab curlayout)
(command "Zoom" "E")
(command "regen")

(reverse list1)
;(reverse list2)
; now do table 
(setq numrows (+ 2 (sslength ss1)))
(setq numcolumns 2)
(setq rowheight 0.2)
(setq colwidth 150)
(setq objtable (vla-addtable curspace pt1 numrows numcolumns rowheight colwidth))
(vla-settext objtable 0 0 "DRAWING REGISTER")
(vla-settext objtable 1 0 "DRAWING NUMBER") 
(vla-settext objtable 1 1 "DRAWING TITLE") 
(SETQ X 0)
(SETQ Y 2)
(REPEAT (sslength ss1)
 (vla-settext objtable Y 0 (NTH X LIST1))
 (vla-settext objtable Y 1 (NTH X LIST2))
 (vla-setrowheight objtable y 10)
 (SETQ X (+ X 1))
 (SETQ Y (+ Y 1))
)
(vla-setcolumnwidth objtable 0 55)
(vla-setcolumnwidth objtable 1 170)
(command "_zoom" "e")
); end AH defun
(AH:dwgindex)
(princ)

[fixo]

Hi Luis, check your private messages

Cheers

[Luís Augusto]

This is a dwg index lisp and makes a table it could be changed to only a single block pick.

 

Bigal, thank you for your reply. Unfortunately unable to use this routine.

 

Hi Luis, check your private messages

Cheers

 

Oleg, thank you very much for your cooperation. I have no words to express my gratitude.

The routine is working perfectly. I'll try to make some changes for it to contemplate any block.

If you allow, i will post the routine changes.

Thank you for everything.

 

Best regards,

Luis Augusto.

[fixo]

Thanks Luis

I was extremely busy, so let me know if you need to add something

in your solution (by PM) to do not waste my time

Cheers

[Luís Augusto]

Hello Oleg.

I have two questions.

The first is whether it is possible to sort the data by pinning before handing over to the autoCADtable.

Second, it would be possible to automate the program point to select all blocks containing a TAG "PIN_ *" and put your autoCADtable next to the connector?

My friend, do not rush to answer. I can circumvent the classification in the creation of the block and the routine is working perfectly, it would be just one more easily and compare the specific programs for such tasks as the E3 series.

Thanks for everything, I have great admiration for his work as a programmer.

A big hug.

 

Luís Augusto.

 

Please put your credits in the routine.

 

Drawing to perform test: Populate table.dwg

(defun C:CLIST(/ acapp acsp adoc atable attdata attitem atts blkname blkobj col en headers pt row sset 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))))
 (if (setq sset (ssget "_:S:E:L"(list (cons 0 "INSERT") (cons 66 1)(cons 410 (getvar "ctab")))))
   (progn
     (setq en (ssname sset 0))
     (setq blkobj (vlax-ename->vla-object en)
    blkname (vla-get-effectivename blkobj)
     )
     (if (/= blkname "*");any other block different "*"
(progn
  (setq atts (vlax-invoke blkobj 'getattributes))
  (foreach attobj atts
    (if (wcmatch (vla-get-tagstring attobj) "PIN_*");change "PIN_#*" use letters also
      (progn
	    (setq attitem (cons (vla-get-tagstring attobj) (vla-get-textstring attobj)))
	    (setq attdata (cons attitem attdata))
	   )
      (setq attdata (reverse attdata ))
    )
   )
  (setq attdata (mapcar '(lambda (a)(list (vl-string-subst "" "PIN_" (car a))(cdr a)))attdata))
  (if (setq pt (getpoint "\nSpecify table location:"))
    (progn
      (setvar 'ctablestyle "TB_CONECTORS")
      (setq atable 
	    (vla-addtable acsp
		  (vlax-3d-point pt)
		  (+ 2 (length attdata))2
		  (/ (getvar 'dimtxt) 2)
		  (* (getvar 'dimtxt) 16)
		)
	  )
      (vla-put-regeneratetablesuppressed atable :vlax-true)
      (setq col 0)
      (foreach wid (list 4.5 30.5)
	    (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 blkname)
     ;(setq title (getstring (strcat "\nTable title: <" blkname ">: ")))
      (if (eq "" title)(setq title blkname))
      (vla-setText atable 0 0 title)
      (vla-setcelltextheight atable 0 0 2.0)
      (vla-SetCellAlignment atable 0 0 acMiddleCenter)
      (setq headers (list "Way" "Circuit / Color / Section / Mark"))
      (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)
	          (if (= 0 col)
	            (vla-SetCellAlignment atable row col acMiddleCenter)
	            (vla-SetCellAlignment atable row col acMiddleLeft)
			   )
	         (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)

[Madruga_SP]

Hi,

Thank you for sharing.

 

Very interesting code!!!

Mr. Oleg thank you very much and Luis Augusto Obrigado!

 

Regards