Requesting any Autocad VBA(.dvb) Files

[Loidy]

Good Day, I would like to request an accessible files of autocad vba (userform/macro/.dvb/.frm). What I am trying to achieve is a toolbar that allows me to compute values and arrange it in a table per layers. Any files could do, related or not, finished or not, i'll try to get some  ideas/codes/formats how its made, still learning some codes. As for example..

 

I draw many lines,polylines, area/region, volume on autocad with different LAYER name each.

then i'll just drag select all the objects I want to compute, then give me result of the TOTAL LENGTH, TOTAL AREA, TOTAL VOLUME, TOTAL COUNT(separated function) showed in TABLE/listbox per LAYER, then later on i'll try to send it to EXCEL.

 

LAYER          |       Length/Area/Volume/Count         |          UNITS

 

Line1             |       100                                                            |          meters

Liner2           |       100                                                            |          meters

 

 

 Area3            |       100                                                            |         sq.meters

 

 Volume4      |       100                                                            |         cu.meters

 

 Count5         |       100                                                            |         pieces

 

 

 

I hope you guys could share some files/sites, I  found some, but it has password and cannot preview the code.

Thanks

 

[PeterPan9720]

Hi @Loidy,

what you are asking it's not so easy because, depending from type of Object found you can have thousand properties, so you should give us an sample drawing based upon that we can show you the main rules of searching an object and retrive properties, count, and so on by VBA.

So please share with us a sample drawing this can help us to find the best solution for what your are requiring.

For example objects are in Model Space or PaperSapce ? Which version of Autocad do you have available, recently some additional functionality had been added.

 

Regards 

[Loidy]

Sorry, here's my sample.. ty

 

REQUEST SAMPLE.dwg

[PeterPan9720]

@Loidy,

thank you for your drawing, just to clarify better:

 

For example you indicate on linear table on LAYER1 12000, and it's correct, but inside the calculation, there is also a region which perimeter are 4000, and this is not considered as a line or polyline, in order to be shown on LINEAR TABLE OBJECT LIST, this a region on layer1.

 

So you want to calculate al object type on the same layer correct ?

 

Thank you.

[Loidy]

@PeterPan9720,

 

I'm sorry. I forgot to update the values. Yes, regardless of line type ( line, polyline, circle, rectangle, arc...) as long as it has length and same layer..

tnx

[BIGAL]

Sent you something read my PM.

 

For others just Google it should be out there 

[PeterPan9720]

Hi @Loidy

here below a sample code, of course could be optimized, but could be a starting point

Sub Layers_DATA()
Dim LayName() As Variant
Dim ObjectsName() As Variant
Dim LayerSx As AcadLayers
Dim LayerX As AcadLayer
Dim MyObject As AcadEntity
Set LayerSx = ThisDrawing.Layers
Count = 1
Count1 = 1
For Each LayerX In LayerSx
    If LayerX.Name <> "0" And LayerX.Name <> "Defpoints" Then
        ReDim Preserve LayName(Count)
        LayName(Count) = LayerX.Name
        Count = Count + 1
        For Each MyObject In ThisDrawing.ModelSpace
            If MyObject.Layer = LayerX.Name Then
                ReDim Preserve ObjectsName(Count1)
                ObjectsName(Count1) = MyObject.ObjectName
               
                Select Case ObjectsName(Count1)
                    Case "AcDbPolyline"
                        TotalLength = TotalLength + MyObject.Length
                    Case "AcDbLine"
                        TotalLength = TotalLength + MyObject.Length
                    Case "AcDbRegion"
                        TotalPerimeter = TotalPerimeter + MyObject.Perimeter
                        TotalArea = TotalArea + MyObject.Area
                    Case "AcDbCircle"
                        TotalCirc = TotalCirc + MyObject.Circumference
                        TotalDiam = TotalDiam + MyObject.Diameter
                    Case "AcDb3dSolid"
                        Debug.Print "PIPO"
                End Select
                Count1 = Count1 + 1
            End If
        Next
    End If
    'TRANSFER DATA TO EXCEL or to a TABLE and reset data and count for next layer
    
    
    TotalLength = 0
    TotalPerimeter = 0
    TotalArea = 0
    TotalCirc = 0
    TotalDiam = 0
    Count1 = 0
    
Next
End Sub

I'm still working on it, due to I have poor experience with 3d objects managing and VBA, see section AcDb3dSolid.

[BIGAL]

Peterpan9720 Arc has length and radius, centroid. Circle centroid maybe add.

 

Using the dumpit.lsp is good for finding the properties of an object, VBA version ?

 

Something I am playing with non VBA gets desired properties via 1 line could be done in VBA using call subfunction.

 

AcDb3dsolid maybe use Massprops. Can write a file and read it back.

 

Pline props.lsp

Edited September 4, 2020 by BIGAL

[PeterPan9720]

Hi @BIGAL, thank you for suggestion, I'll look forward.

 

Bye

[Loidy]

@PeterPan9720 thanks sir, but  I'm still struggling how to use it using selectionset and how to put it in table.

[PeterPan9720]

On 9/5/2020 at 1:10 AM, BIGAL said:

Peterpan9720 Arc has length and radius, centroid. Circle centroid maybe add.

 

Using the dumpit.lsp is good for finding the properties of an object, VBA version ?

 

Something I am playing with non VBA gets desired properties via 1 line could be done in VBA using call subfunction.

 

AcDb3dsolid maybe use Massprops. Can write a file and read it back.

 

Pline props.lsp 3.62 kB · 0 downloads

 

6 hours ago, Loidy said:

@PeterPan9720 thanks sir, but  I'm still struggling how to use it using selectionset and how to put it in table.

 

See Autodesk forum, https://forums.autodesk.com/t5/vba/vba-for-computing-total-length-area-volume-count-for-every/m-p/9727578  For last update.

I'm still working, when I have time, I've some issue with 3D objects.

Bye