Dynamic block extract to table

[Spaj]

Hi

 

I'm trying to put together a LISP routine that will tabulate specific properties of numerous specific dynamic blocks in a drawing. I have manged to find the code below (Thanks to Fixo? and HMSilva) which has been modified to only recognize XRefed blocks. How do I remove the logic that tests for this? I have identified the code (IsXref) which test for this condition but how to eliminate this eludes me.

 

Eventually I would like to include the co-ordinates of the start and end of each block in the table.

 

;| 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) "*|Duct")
           )
         (progn
           (setq atts (vlax-invoke x 'getattributes))
           (foreach att atts
             (cond ((wcmatch (vla-get-tagstring att) "DUCT_START")
                    (setq a1 (vla-get-textstring att))
                   )
                   ((wcmatch (vla-get-tagstring att) "DUCT_END")
                    (setq a2 (vla-get-textstring att))
                   )
                   ((wcmatch (vla-get-tagstring att) "DUCTTYPE")
                    (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 "DUCTS")
     (vla-setText atable 0 0 title)
     (vla-setcelltextheight atable 0 0 2.0)
     (vla-SetCellAlignment atable 0 0 acMiddleCenter)
     (setq headers (list "START" "END" "TYPE"))
     (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)

[Dadgad]

Have you checked out http://www.lee-mac.com/dynamicblockcounter.html ?

Sounds like pretty much what you are looking for.

 

Thanks Lee!

[Spaj]

Hi

 

Yep, I looked at this for pointers, but the code above is closer to what I need.

[Tharwat]

Hi,

 

Can you give an example of the final result of the table including the coordinates via an image or a drawing?

[Spaj]

Hi Tharwat

 

Attached is an example. The idea is to extract the data from the dynamic blocks and tabulate as shown in the example. Note that the tabulated co-ords are transposed and signed as a result of our south orientated survey system.

 

Ducts Example.dwg

 

Thanks for your interest.

[BIGAL]

Here is a table create example my be helpful.

 

; 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 xxx jobs
(progn 
(setq bname "XXXX_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 7)
(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)

[Spaj]

Hi

 

 

Thanks for the input, but it's more the extraction of data from the Dynamic blocks that I'm battling with.

[Tharwat]

Hi Tharwat

 

Attached is an example. The idea is to extract the data from the dynamic blocks and tabulate as shown in the example. Note that the tabulated co-ords are transposed and signed as a result of our south orientated survey system.

 

Thanks for your interest.

 

Spaj, please give a clear explanation for one block with its coordinates as shown in the table and when to add minus or plus symbols.

[Spaj]

Hi Tharwat

 

Sorry for the confusion. Attached is an example. Simply put, co-ords generated in AutoCAD need to be transposed ie X becomes the Y value and Y becomes the X value, but with the opposite signs.

 

Ducts Example1.dwg

 

This is due to the non standard survey co-ord system in SA which is south orientated and angular measure is anti-clockwise with co-ords quoted Y then X. The best compromise in AutoCAD is to work in the 3rd quadrant cartesian system (where X and Y values are -ve). This allows for the correct orientation, the correct sequence of co-ordinate values, but with the drawback of the values having the incorrect sign. Therefore all quoted co-ords need to be transposed and signed.

[Spaj]

Hi

 

Do you perhaps know how to eliminate the logic to check that the block is an XRef in the attached code?

 

(defun C:CLIST (/ a1 a2 a3 acapp acsp adoc atable att attdata atts blk col coords headers pt row 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)))
 )

 (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) "*|Duct")
           )
         (progn
           (setq atts (vlax-invoke x 'getattributes))
       (foreach att atts
             (cond ((wcmatch (vla-get-tagstring att) "DUCT_START")
                    (setq a1 (vla-get-textstring att))
            ;(setq coordStart (vlax-get att insertionpoint))
                   )
                   ((wcmatch (vla-get-tagstring att) "DUCT_END")
                    (setq a2 (vla-get-textstring att))
                    ;(setq coordEnd (vlax-get att insertionpoint))
                   )
                   ((wcmatch (vla-get-tagstring att) "DUCT_TYPE")
                    (setq a3 (vla-get-textstring att))
                   )
             ) ;end Cond
           ) ; end ForEach
           (setq attdata (cons (list a1 a2 a3) attdata))
         ) ; end Progn
       ); end If
     ) ; end for
   ) ;end if
 ) ;end For

Thanks

[Lee Mac]

Comment the if statement and the corresponding closing parenthesis (comment lines 10 & 35), and remove the pipeline character from the wcmatch expression.

[marko_ribar]

Lee was quicker...

 

As a portion of bigger code, I think this remove logic of checking if object is Xref...

 

(defun C:CLIST (/      a1     a2     a3     acapp  acsp   adoc   atable
               att    attdata       atts   blk    col    coords headers
               pt     row    title  x
              )

 (vl-load-com)

 (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)
   (vlax-for x blk
     (if (and (= (vla-get-ObjectName x) "AcDbBlockReference")
              (= (strcase (vla-get-EffectiveName x)) "DUCT")
         )
       (progn
         (setq atts (vlax-invoke x 'getattributes))
         (foreach att atts
           (cond ((wcmatch (vla-get-tagstring att) "DUCT_START")
                  (setq a1 (vla-get-textstring att))
 ;(setq coordStart (vlax-get att insertionpoint))
                 )
                 ((wcmatch (vla-get-tagstring att) "DUCT_END")
                  (setq a2 (vla-get-textstring att))
 ;(setq coordEnd (vlax-get att insertionpoint))
                 )
                 ((wcmatch (vla-get-tagstring att) "DUCT_TYPE")
                  (setq a3 (vla-get-textstring att))
                 )
           ) ;end Cond
         ) ; end ForEach
         (setq attdata (cons (list a1 a2 a3) attdata))
       ) ; end Progn
     ) ; end If
   ) ; end for
 ) ;end For
 ...

[Tharwat]

What is the use of or function as long as the variable is localised?

[Spaj]

Hi Lee

 

Comment the if statement and the corresponding closing parenthesis (comment lines 10 & 35), and remove the pipeline character from the wcmatch expression.

 

Thanks, that worked. I had the comment out the if statement and corresponding parenthesis But not the pipeline! What is the significance of the pipeline?

 

Unfortunately I now have an ActiveX Server returned an error: Parameter not

optional from the remainder of the code.

[Spaj]

Hi Marko

 

Thanks for the input, but that did not seem to work. The routine does not recognize the specified blocks.

[Lee Mac]

What is the significance of the pipeline?

 

Table names (i.e. layers, blocks, linetypes etc.) which contain the pipe character are xref-dependent items, with the content to the left of the pipe equal to the name of the xref from which they are derived.

 

Unfortunately I now have an ActiveX Server returned an error: Parameter not optional from the remainder of the code.

 

Can you post your current modified code?

[Spaj]

Table names (i.e. layers, blocks, linetypes etc.) which contain the pipe character are xref-dependent items, with the content to the left of the pipe equal to the name of the xref from which they are derived.

 

Aha, helps if you understand these nuances.

 

Can you post your current modified code?

 

Sure...

 

CList_Duct.LSP

[Lee Mac]

Without testing the code, I suspect that the error arises because one of the attribute values is null, as the variables holding each attribute value are not tested for validity following evaluation of the foreach loop before being pushed onto the main data list:

(progn
           (setq atts (vlax-invoke x 'getattributes))
       (foreach att atts
             (cond ((wcmatch (vla-get-tagstring att) "DUCT_START")
                    (setq a1 (vla-get-textstring att))
            ;(setq coordStart (vlax-get att insertionpoint))
                   )
                   ((wcmatch (vla-get-tagstring att) "DUCT_END")
                    (setq a2 (vla-get-textstring att))
                    ;(setq coordEnd (vlax-get att insertionpoint))
                   )
                   ((wcmatch (vla-get-tagstring att) "DUCT_TYPE")
                    (setq a3 (vla-get-textstring att))
                   )
             ) ;end Cond
           ) ; end ForEach
           (setq attdata (cons (list [highlight]a1 a2 a3[/highlight]) attdata))
         )

An easy way to test this theory is to print the value of attdata after evaluation of the outer vlax-for loop.

[Spaj]

Without testing the code, I suspect that the error arises because one of the attribute values is null, as the variables holding each attribute value are not tested for validity following evaluation of the foreach loop before being pushed onto the main data list. An easy way to test this theory is to print the value of attdata after evaluation of the outer vlax-for loop.

 

 

Correct, one of the block attribute names did not correspond with the name in the foreach loop.

 

 

Thank you kindly for the help.

[Lee Mac]

You're welcome!