VBA to extract block data in to the standard excel template

[deepalikhot2]

• I have attached a CAD file with some Dynamic Blocks. As well as our Standard Output Excel.
  Those block are used for our office work called PANEL COUNT. That proccess is known for the estimate of Required Panels for a architectural wall face.
  We Paste those blocks on the Elevation of building and later we Input the data Manually (One by One) in our Standard output excel in the form of Length & Width.
  After Data Extraction we paste that data manually in our Standard Excel.
  I want to create an Automation Command with which we can directly Generate the Excel Similar To Our Standard Excel.
  I highly recommend the VBA command for this. If its not possible then some Excel VBA would do the work. But it has to create direct output of our data.

[deepalikhot2]

I need help to solve my problem.

[grobnik]

@deepalikhot2 Hi, I guess you should first of all find on this forum how to transfer blocks attribute to excel, there are a lot of post. Do you have any experience with VBA ?. Do you have development module for Autocad ? it's only available only on full Autocad release.

You can use both side Excel and Autocad. I'm suggesting to use Autocad as "master" and Excel as "slave".

As second issue on your excel file there a lot of field to be filled, are all data available on drawing or some data are not in the drawing. Do you need only to retrieve length and width ?

Block names will be always A1 A2 B1 B2 etc or could be different?

I'll show you later some example of code on Autocad side.

[deepalikhot2]

I just want panel quantities, lengths, widths, color of the panels...other
than this all are similar to all extraction (ex. -16mm, +50mm, total area)

[deepalikhot2]

Block name could be any from 1 to ........(A panel have only 1 length and 1 width, B panel have 2 length and 1 width or 1 length and 2 widths, C panel have 3 length and 1 width or 1 length and 3 widths etc. )

[grobnik]

@deepalikhot2 Here an example, without the excel section.

Sub ContaB()
For Each MYOBJECT In ThisDrawing.ModelSpace
    If TypeOf MYOBJECT Is AcadBlockReference Then
        If MYOBJECT.Name = "C1" Then
            If MYOBJECT.HasAttributes = True Then
                QQ = MYOBJECT.GetAttributes
                ZZ = MYOBJECT.GetDynamicBlockProperties
                AA = ZZ(2).PropertyName
                BB = ZZ(2).Value
            End If
        End If
    End If
Next
End Sub

I'll try to explain how it's working:

- First step is searching for a block named "C1". Here there are a lot of way to search C1, 2 and so on. Just to help you to understand I asked to search only "C1".

QQ variable will be an array with all attributes (in your case you should have only one attribute equal to block name if I have not wrongly understand).

See QQ(0).TextString and QQ(0).Tagstring.

ZZ Variable will contain all dynamic block properties like as with and length.

See picture below

Once you have all variable you can write on excel object. I'll give you later the code to point to an Excel sheet.

I hope all above will give you more or less the way to approach your issue.

[grobnik]

@deepalikhot2 Here with Excel

Keep opened your Excel file, data will be added to row 13 just for example.

Sub ContaB()
CountC1 = 0
For Each MYOBJECT In ThisDrawing.ModelSpace
    If TypeOf MYOBJECT Is AcadBlockReference Then
        If MYOBJECT.Name = "C1" Then
        CountC1 = CountC1 + 1
            If MYOBJECT.HasAttributes = True Then
                QQ = MYOBJECT.GetAttributes
                ZZ = MYOBJECT.GetDynamicBlockProperties
                AA = ZZ(2).PropertyName
                BB = ZZ(2).Value
            End If
        End If
    End If
Next

Set ObjExcel = GetObject(, "Excel.Application")
ObjExcel.Visible = True
ObjExcel.Workbooks(ObjExcel.ActiveWorkbook.Name).Activate

ObjExcel.Sheets("C_PANEL").Activate
ObjExcel.Activesheet.Range("C13").Value = QQ(0).TextString
ObjExcel.Activesheet.Range("E13").Value = CountC1
ObjExcel.Activesheet.Range("F13").Value = BB

End Sub

[grobnik]

@deepalikhot2 Here an update of procedure where all blocks will be selected (A,B,C,D, 1 and 2), after that has been selected the block "C1" for test and pasted value in Excel on proper sheet "C_PANEL".

I guess now it's more flexible for you, you have to add some additional controls, for example check if the excel file name is open, if it is the exactly working file name, check if dynamic block property name is right before paste into excel, reset the count of "PANELS" at the end of procedure, and so on. You can of course add all the other blocks applying the same rules.

Let me know

Sub ContaB2()
Dim s2 As AcadSelectionSet
CountA1 = 0
CountB1 = 0
CountC1 = 0
CountD1 = 0
CountA2 = 0
CountB2 = 0
CountC2 = 0
CountD2 = 0

Set ObjExcel = GetObject(, "Excel.Application")
ObjExcel.Visible = True
ObjExcel.Workbooks(ObjExcel.ActiveWorkbook.Name).Activate

On Error Resume Next
    Set s2 = ThisDrawing.SelectionSets.Add("ssBlocks")
    If Err.Number <> 0 Then
        Set s2 = ThisDrawing.SelectionSets.Item("ssBlocks")
        s2.Clear
    End If

Dim intFtyp(3) As Integer                       ' setup for the filter
Dim varFval(3) As Variant
Dim varFilter1, varFilter2 As Variant
intFtyp(0) = -4: varFval(0) = "<OR"
intFtyp(1) = 0: varFval(1) = "INSERT"           ' get only blocks
intFtyp(2) = 2: varFval(2) = "A*,B*,C*,D*"          ' whose name is specified in argument
intFtyp(3) = -4: varFval(3) = "OR>"
varFilter1 = intFtyp: varFilter2 = varFval
s2.Select acSelectionSetAll, , , varFilter1, varFilter2        ' do it

For Each MyEntity In s2
'
 If TypeOf MyEntity Is AcadBlockReference Then
    Set pl = MyEntity
        If pl.EffectiveName = "C1" Then
            CountC1 = CountC1 + 1
            ObjExcel.Sheets("C_PANEL").Activate
            If pl.HasAttributes = True Then
                QQ = pl.GetAttributes
                ZZ = pl.GetDynamicBlockProperties
                'AA = ZZ(2).PropertyName
                BB = ZZ(2).Value
                CC = ZZ(4).Value
                DD = ZZ(6).Value
                EE = ZZ(8).Value
                ObjExcel.Activesheet.Range("C13").Value = QQ(0).TextString 'NAME
                ObjExcel.Activesheet.Range("E13").Value = CountC1 'PANEL TYPE COUNT
                ObjExcel.Activesheet.Range("F13").Value = BB 'WIDTH 1 (mm)
                ObjExcel.Activesheet.Range("G13").Value = CC 'WIDTH 2 (mm) G
                ObjExcel.Activesheet.Range("H13").Value = DD 'WIDTH 3 (mm) H
                ObjExcel.Activesheet.Range("L13").Value = EE 'LENGTH 1 (mm) L
            End If
        End If
 End If

Next

End Sub

[grobnik]

@deepalikhot2 Hi,

here attached the complete version of Autocad procedure and related file excel automatically filled on name, quantity, width and length for all 8 blocks you showed on drawing.

Concerning the color you should add for each block section the code 

MyColor=pl.color

Later place MyColor value on excel row and column do you want, please note that in your attached drawing blocks' colour code is "byLayer" and layer settled to 0 so different from value you indicate in excel file.

I'm suggesting to prepare an excel model file xlst extension with all standard value, format, formula, and use the procedure only to paste the blocks value.

Actually procedure catch only blocks named A,B,C,D 1 to 2, if you need to add it's simply follow the code where you find the name of block, and of course check the right width and length position into block properties array ZZ.

Let me know

[deepalikhot2]

I have tried your code in the AutoCAD VBA & it’s working but the excel filling up considering to block names (A1, A2, B1, B2, C1, C2, D1, D2) but I need to count those panels by considering panel numbers (Piece No.). I am using this blocks to panel count purposes, the panel labeling will be any as per the sizes. In the excel panel type should be block piece number.

[grobnik]

Hi @deepalikhot2 really I don't understand your dubts.

The procedure is counting each type of block inside the drawing, from those filtered before by SelectionSet function.

intFtyp(2) = 2: varFval(2) = "A*,B*,C*,D*, add here other name of block(s)"

see section A1 for example

CountA1 = CountA1 + 1, later the excel cells will contain the sum of blocks A1 counted into selection.

If the count criteria shall be different, probably I don't understand well your counting criteria.

Again if you need to add some other panels you can add here:

intFtyp(2) = 2: varFval(2) = "A*,B*,C*,D*, add here other name of block(s)"

I found only and error in the section B1, where data write into excel file it's wrong. You have to modify the code as follow:

ObjExcel.Activesheet.Range("E" & MyRow).Value = CountB1 'PANEL TYPE COUNT

Let me know.

Bye

[grobnik]

Hi,

Hi @deepalikhot2 

In case the amount of each panel has been already inserted in the PIECE-NO block attribute you can modify each section as follow

ObjExcel.Activesheet.Range("C" & MyRow).Value =  pl.EffectiveName 'NAME
ObjExcel.Activesheet.Range("E" & MyRow).Value = Val(QQ(0).TextString)) 'PANEL TYPE COUNT