Export Block count and Description in Excel

[dober]

Thanks Bigal

Unfortunately I don't speak English and it could come across wrong.

I want to write dynamic blocks in Excel using the Lisp "Block2Excel".

Certain blocks will then be visible in the visibility, and I want to bring them into Excel to get a parts list.

 

Danke Bigal

 

Leider kann ich kein Englisch und es kann dann falsch rüber.

 

Ich will Dynamische Blöcke mit dem Lisp "Block2Excel"  in Excel raus schreiben lassen.

In denn Sichtbarkeiten werden dann bestimmte Blöcke sichtbar, die will ich dann in Excel bringen um eine Stückliste zu erhalten.

 

[BIGAL]

I use my own version of "Block2Excel". As it normally needs some form of customization. Yes can select blocks and export direct to Excel. I based my code on Getexcel.lsp and functions by "FIXO".

 

I have sort and count Block attributes for total numbers of various blocks and their attribute combinations. Up to 5 attributes deep.

 

eg

DOOR Black 2040 820 24

DOOR Black 2040 750 3

DOOR Black 2100 820 5

 

So need a sample dwg a few blocks and a matching Excel, can then maybe provide code. Its a task asked many times so many here can help.

 

 

[dober]

Thanks Bigal

Yes, that's what it should be.
Dynamic and normal blocks should be counted.
and write that in Excel.

Attached is a small dwg with a few sample blocks

 

Thanks Bigal

Yes, that's what it should be.
Dynamic and normal blocks should be counted.
and write that in Excel.

Attached is a small dwg with a few sample blocks

test Symbole 2024.dwg

[BIGAL]

Thanks for dwg Understand count visibility and normal block with attributes. 

 

[dober]

Hello Bigal

I don't understand the question.

Switches are dynamic blocks

the lights are normal blocks

 

Hallo Bigal

 

Ich versteh die Frage nicht.

Schalter sind Dynamische Blöcke

die Leuchten sind normale Blöcke

 

[dober]

This is what a list should be in Excel

 

So eine Liste soll das werden in Excel

test Symbole 2024.xlsx

[BIGAL]

Thank you for Excel. Understand what you want, just need to find time to do something. Will do a sort on the "name" notice in Excel a mix of names. 

[dober]

Danke Bigal

[BIGAL]

Working on it need to fix a couple of things. 

 

 

[dober]

Ok thanks for the info

[BIGAL]

Give this a try select say brown blocks then dynamic blocks.

 

 

test.lsp

[dober]

Thanks Bigal

Everything works perfectly in the test drawing.

But when I test it in a colleague's DWG, it doesn't work like it did in the test drawing.

A lot of blocks are missing

 

 

Danke Bigal

In der Testzeichnung funktioniert alles perfekt.

Aber wenn ich es in einer DWG von einem Kollegen Teste geht es nicht so wie in der Testzeichnung.

 

Da fehlen sehr viele Blöcke

 

[dober]

We wouldn't need all that, see picture
Only count blocks. Write out normal blocks and dynamic blocks in an Excel list.

 

Das würden wir alles nicht brauchen siehe Bild
Nur Blöcke zählen Normale Blöcke und Dynamische Blöcke in eine Excelliste rausschreiben.

[BIGAL]

When a dwg does not works post it here or you can Private message me.

 

Can change code to blockname & option visibilty. 

[dober]

Thanks Bigal

Attached is a test DWG

test 001 Elektro - 2013.zip

[dober]

Hello Bigal

Do you need anything else?

Thanks

[BIGAL]

Maybe have time today to go back to it, been busy going fishing etc, have to get the priorities right.

[BIGAL]

Try this please.

 

;  Take a block atts and make them into a table 
; counting the blocks also
; by Alan H April 2018 now Aug 2024 customised to suit task


(defun CreateTableStyle( / dicts dictobj key class custobj )
    
;; Get the Dictionaries collection and the TableStyle dictionary
(setq dicts (vla-get-Dictionaries (vla-get-ActiveDocument(vlax-get-acad-object))))
(setq dictObj (vla-Item dicts "acad_tablestyle"))
(setq txtht (getreal "\nEnter text height "))
(setq dname (strcat "table" (rtos txtht 2 2)))

(vlax-for dictname dictobj
(if (=  (vlax-get dictname 'name) dname)
(princ "yes")

(progn

;; Create a custom table style
(setq key dname class "AcDbTableStyle")
(setq custObj (vla-AddObject dictObj key class))

;; Set the name and description for the style
(vla-put-Name custObj dname)
(vla-put-Description custObj (strcat dname " custom table style"))

;; Sets the bit flag value for the style
(vla-put-BitFlags custObj 1)

;; Sets the direction of the table, top to bottom or bottom to top
(vla-put-FlowDirection custObj acTableTopToBottom)

;; Sets the horizontal margin for the table cells
(vla-put-HorzCellMargin custObj txtht )

;; Sets the vertical margin for the table cells
(vla-put-VertCellMargin custObj txtht )

;; Set the alignment for the Data, Header, and Title rows
(vla-SetAlignment custObj (+ acDataRow acHeaderRow acTitleRow) acMiddleCenter)

;; Set the text height for the Title, Header and Data rows
(vla-SetTextHeight custObj acDataRow txtht)
(vla-SetTextHeight custObj acHeaderRow (* txtht 1.2))
(vla-SetTextHeight custObj acTitleRow (* txtht 1.5))

;; Set the text height and style for the Title row
(vla-SetTextStyle custObj (+ acDataRow acHeaderRow acTitleRow) "Arial")

)
)
)
(setvar 'ctablestyle dname)
(princ)
)


(defun  AH:gotable (obj3 / txt)
(repeat (setq k (length lst3))
(setq rownum (vla-get-rows obj3))
(vla-InsertRows obj3  rownum  (vla-GetRowHeight obj3 1) 1)
(setq strlst (nth (setq k (- k 1)) lst3))
(setq txt  (car (car strlst)))
(vla-settext obj3 rownum  0  txt)
(setq txt  (cadr (car strlst)))
(if (or (= txt "")(= txt nil))
(princ)
(vla-settext obj3 rownum 1 txt)
)
(setq txt  (rtos (cadr strlst) 2 0))
(vla-settext obj3 rownum 2 txt)
(vla-SetRowHeight obj3 rownum (* txtht 2.0))
)
)


(defun AH:table_make ( / )

(command "table" 3 3 (getpoint "\nPick point for table "))
(setq objtable (vlax-ename->vla-object (entlast)))
(vla-settext objtable 0 0 "TABLE title")
(vla-settext objtable 1 0 "Block")
(vla-settext objtable 1 1 "Visibility")
(vla-settext objtable 1 2 "Count")
(vla-setrowheight objtable 0 (* txtht 2.5))
(vla-setrowheight objtable 1 (* txtht 2.5))
(vla-setrowheight objtable 2 (* txtht 2.5))
(vla-Setcolumnwidth objtable 0 (* (nth 0 collst)(* txtht 1.5)) )
(vla-Setcolumnwidth objtable 1 (* (nth 1 collst)(* txtht 1.5)) )
(vla-Setcolumnwidth objtable 2 (* txtht 7))
)

; cmaxstrlen thanks to lee-mac
(defun cmaxstrlen ( l )
    (if (apply 'or l)
        (cons (apply 'max (mapcar 'strlen (subst "" nil (mapcar 'car l))))
              (cmaxstrlen (mapcar 'cdr l))
        )
    )
)


;; Get Dynamic Block Property Value  -  Lee Mac
;; Returns the value of a Dynamic Block property (if present)
;; blk - [vla] VLA Dynamic Block Reference object
;; prp - [str] Dynamic Block property name (case-insensitive)

(defun LM:getdynpropvalue ( blk prp )
    (setq prp (strcase prp))
    (vl-some '(lambda ( x ) (if (= prp (strcase (vla-get-propertyname x))) (vlax-get x 'value)))
        (vlax-invoke blk 'getdynamicblockproperties)
    )
)

;; Get Visibility Parameter Name  -  Lee Mac
;; Returns the name of the Visibility Parameter of a Dynamic Block (if present)
;; blk - [vla] VLA Dynamic Block Reference object
;; Returns: [str] Name of Visibility Parameter, else nil

(defun LM:getvisibilityparametername ( blk / vis )  
    (if
        (and
            (vlax-property-available-p blk 'effectivename)
            (setq blk
                (vla-item
                    (vla-get-blocks (vla-get-document blk))
                    (vla-get-effectivename blk)
                )
            )
            (= :vlax-true (vla-get-isdynamicblock blk))
            (= :vlax-true (vla-get-hasextensiondictionary blk))
            (setq vis
                (vl-some
                   '(lambda ( pair )
                        (if
                            (and
                                (= 360 (car pair))
                                (= "BLOCKVISIBILITYPARAMETER" (cdr (assoc 0 (entget (cdr pair)))))
                            )
                            (cdr pair)
                        )
                    )
                    (dictsearch
                        (vlax-vla-object->ename (vla-getextensiondictionary blk))
                        "ACAD_ENHANCEDBLOCK"
                    )
                )
            )
        )
        (cdr (assoc 301 (entget vis)))
    )
)

;; Get Dynamic Block Visibility State  -  Lee Mac
;; Returns the value of the Visibility Parameter of a Dynamic Block (if present)
;; blk - [vla] VLA Dynamic Block Reference object
;; Returns: [str] Value of Visibility Parameter, else nil

(defun LM:getvisibilitystate ( blk / vis )
    (if (setq vis (LM:getvisibilityparametername blk))
        (LM:getdynpropvalue blk vis)
    )
)

(defun my-count (a L)
  (cond
   ((null L) 0)
   ((equal a (car L)) (+ 1 (my-count a (cdr L))))
   (t (my-count a (cdr L))))
)

; By Gile
(defun remove_doubles (lst)
  (if lst
    (cons (car lst) (remove_doubles (vl-remove (car lst) lst)))
  )
)

; Starts here ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun c:AHblock-atts ( / x  k i obj obj2 ans ans2  lst lst2 collst)

(setq ss (ssget '((0 . "Insert"))))

(setq lst '())
(repeat (setq  x (sslength ss))
(setq lst2 '())
(setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
(if  (= (vlax-invoke obj 'getdynamicblockproperties) nil)
(setq lst2 (cons "-" lst2))
(setq lst2 (cons (LM:getvisibilitystate obj) lst2))
)
(setq lst2 (cons (vla-get-EffectiveName obj) lst2))
(setq lst (cons lst2 lst))
)

(setq lst (vl-sort lst
	 '(lambda (a b)
	    (cond
	      ((< (cadr a) (cadr b)))
	      ((= (cadr a) (cadr b)) (< (caddr a) (caddr b)))
	    )
	  )
)
)

; maybe replace with length collst
(setq collst (cmaxstrlen lst))

(CreateTableStyle)
(AH:table_make)

(command "regen")

(setq lst2 (remove_doubles lst))
(foreach val lst2
    (setq cnt (my-count val lst))
    (setq lst3 (cons (list val cnt) lst3))
)


(AH:gotable (vlax-ename->vla-object (entlast)))
(princ)
)

(c:AHblock-atts)

 

[dober]

100 times thanks Bigal

 

100 mal Danke Bigal

 

It would be nice if it was written straight into an Excel list.

But that is just a suggestion

 

[BIGAL]

Can do 2 ways use "table to excel", or I do have code for write direct to excel. It would be pretty easy to just load a modified version of table to excel where you just do (load "table to excel") say in a If.

 

Add this at end before last (princ)

(setq ans (strcase (getstring "\nSend to Excel Y Yes N No ")))
(cond
((or (= and "YES")(= ans "Y"))(load "table to excel"))
((or (= and "No")(= ans "N"))(princ "\nNo Excel"))
)

 

table to excel.lsp