topic Re: List all polylines, inner texts and dimensions in VBA Forum

List all polylines, inner texts and dimensions

Anonymous — Mon, 08 Nov 2021 11:23:40 GMT

Dears,

One user requested me a Excel VBA to list all polylines, inner texts and dimensions.

I checked on search and could not find a solution.

I attached a AutoCAD example.

There are several polylines and I know I need to make a loop to get all polylines and check one by one if there is a text inside it and after that make a way to link the dimension to the polyline.

Thank you

Re: List all polylines, inner texts and dimensions

grobnik — Mon, 08 Nov 2021 13:56:10 GMT

Hi,

looking at dwg, seems that figure you showed are not polyline but only line.

Could you please clarify ?.

Re: List all polylines, inner texts and dimensions

Anonymous — Mon, 08 Nov 2021 13:58:51 GMT

@grobnik you are right.

I justa talked to the user.

He told me that the lines are not closed.

I thought they were closed polylines.

I think it will not possible as they are not a single line or a closed polyline to identify if there is a text inside it, right?

Re: List all polylines, inner texts and dimensions

grobnik — Mon, 08 Nov 2021 14:32:21 GMT

@Anonymous everything it will be possible, it depends what will be the purpose, of course if you want export vertex of polyline, instead single lines I guess it will be more easy.

Re: List all polylines, inner texts and dimensions

Anonymous — Mon, 08 Nov 2021 15:53:55 GMT

Yes I think I will nedd to first convert the lines on one closed polyline.

I just prepared a VBA to list the lines.

Now I need to find a way to make a single closed polyline.

Public Sub lista_poly() Dim Myapp As Object Dim MyDwg As AcadDocument Dim obj As AcadObject Dim ent As AcadEntity Dim text As AcadText Dim w As Worksheet Dim Ppos() As Double Dim line As AcadLine Dim pontos As Double Set Myapp = GetObject(, "Autocad.application") Set MyDwg = Myapp.ActiveDocument i = 2 tot_ent = MyDwg.ModelSpace.Count 'conta quantidade de objetos no AutoCad For i2 = 0 To tot_ent - 1 type_ent = MyDwg.ModelSpace.Item(i2).ObjectName If type_ent = "AcDbLine" Then Set line = MyDwg.ModelSpace.Item(i2) CCelula = "A" & i CCelula2 = "B" & i CCelula3 = "C" & i 'Ddim = MyDwg.ModelSpace.Item(i2).Measurement 'Dim retPoint As Variant 'retPoint = MyDwg.ModelSpace.Item(i2).TextPosition Worksheets("Planilha1").Range(CCelula).Value = line.StartPoint(0) Worksheets("Planilha1").Range(CCelula2).Value = line.StartPoint(1) 'Worksheets("Planilha1").Range(CCelula2).Value = line.EndPoint Worksheets("Planilha1").Range(CCelula3).Value = line.ObjectID i = i + 1 End If Next End Sub

Re: List all polylines, inner texts and dimensions

grobnik — Mon, 08 Nov 2021 15:58:49 GMT

@Anonymous ,

Ok, I'll look at your code, but seems you are doing the opposite, so instead export to excel you are writing your code in excel searching polylines into the drawing.

I guess it's better to do the opposite, due to sometimes could be not so easy pointing object, or using some functionality available in Autocad VBA, instead Excel VBA, however it's a choice.

Re: List all polylines, inner texts and dimensions

Anonymous — Mon, 08 Nov 2021 16:23:00 GMT

I'm quite new at AutoCAD, so I was thinking about identifying the right sequence on Excel and return to AutoCAD with the points.

Is there a way through VBA to use the "JOIN" sending the ObjectIDs?

Re: List all polylines, inner texts and dimensions

grobnik — Mon, 08 Nov 2021 17:14:10 GMT

Hi @Anonymous Now I'm confused please help me to understand well:

1) You want to use excel VBA instead Autocad VBA ok it's a choice.

2) You have a drawing with lines not jointed and you want to export vertex to Excel right ? but with identification by text inside.

2a) Option to point 2: you have vertex in Excel and want to transfer to CAD as line or Polyline ? and write text inside ?

3) Do you want to transform or "joint" lines to polylines ?

I guess that argument are different from your starting request. If you want I can help you with option 1, but I guess the single lines shall be converted in polyline.

In addition I would like you just a couple of questions on text inside. it will be always on the same layer ? or could be different. Looking at your drawing text inside it's placed on two different coordinates, contents seems equal could you confirm ? thank you.

Re: List all polylines, inner texts and dimensions

Anonymous — Mon, 08 Nov 2021 18:36:34 GMT

1) You want to use excel VBA instead Autocad VBA ok it's a choice.

Yes, I want to use Excel VBA

2) You have a drawing with lines not jointed and you want to export vertex to Excel right ? but with identification by text inside.

That is right, I want to make a table with dimension and text.

2a) Option to point 2: you have vertex in Excel and want to transfer to CAD as line or Polyline ? and write text inside ?

The Excel file with vertex would be an intermediate step to transform the line on polyline.

3) Do you want to transform or "joint" lines to polylines ?

I do not need to transform to polyline, but it seems easier to work. And there is another point, there are several "polygons" on the dwg file. So I think the best way to assure the matching is making them a polyline.

Thank you for your attention

Re: List all polylines, inner texts and dimensions

grobnik — Wed, 10 Nov 2021 07:36:52 GMT

Hi @Anonymous ,

here below a sample code, that could be fixed more but it's a starting point, that should help you with your issue

Public Sub lista_poly() Dim Myapp As Object Dim MyDwg As AcadDocument Dim Obj As AcadObject Dim Ent As AcadEntity Dim text As AcadText Dim w As Worksheet Dim Ppos() As Double Dim line As AcadLine Dim pontos As Double Dim MySset As AcadSelectionSet Dim FilterType(4) As Integer Dim FilterData(4) As Variant Dim P1(0 To 2) As Double Dim P2(0 To 2) As Double R = 2 Set Myapp = GetObject(, "Autocad.application") Set MyDwg = Myapp.ActiveDocument Sheets(1).Range("B1") = "X" Sheets(1).Range("C1") = "Y" For Each Obj In MyDwg.ModelSpace If TypeOf Obj Is AcadLWPolyline Then Line_Pos = Obj.Coordinates For i = 0 To UBound(Line_Pos) Step 2 Sheets(1).Range("B" & R) = Line_Pos(i) Sheets(1).Range("C" & R) = Line_Pos(i + 1) R = R + 1 Next ' GetMaxNumber (Line_Pos) P1(0) = Line_Pos(0) P1(1) = Line_Pos(1) P1(2) = 0 P2(0) = UBound(Line_Pos) - 1 P2(1) = UBound(Line_Pos) P2(2) = 0 On Error Resume Next Set MySset = MyDwg.SelectionSets.Add("MySel") If Err.Number <> 0 Then MyDwg.SelectionSets.Item("MySel").Delete Set MySset = MyDwg.SelectionSets.Add("MySel") End If FilterType(0) = -4 FilterData(0) = "<or" FilterType(1) = 0 FilterData(1) = "TEXT" FilterType(2) = 0 FilterData(2) = "MTEXT" FilterType(3) = 0 FilterData(3) = "DIMENSION" FilterType(4) = -4 FilterData(4) = "or>" 'MySset.Select acSelectionSetWindow, P2, P1, FilterType, FilterData MySset.Select acSelectionSetAll, , , FilterType, FilterData If MySset.Count >= 1 Then For a = 0 To MySset.Count Select Case MySset.Item(a).ObjectName Case "AcDbText" Sheets(1).Range("A" & R) = MySset.Item(a).TextString Case "AcDbRotatedDimension" Debug.Print "DIMENSION ROTATED" Sheets(1).Range("D" & R) = MySset.Item(a).Measurement R = R + 1 End Select Next End If End If Next End Sub

It's based upon a polyline, see attached drawing.

The part of code 'MySset.Select acSelectionSetWindow, P2, P1, FilterType, FilterData, could be used for refine text search related inside the founded polyline.

I mean, that whenever you find a polyline object, and you are retrieving the coordinates, you can with a function find the max and min value inside the vertex coordinates array, based upon that value in the coordinates array are stored by X, following Y value for each vertex.

So if you search TEXT, and DIMENSION with Selection Set around the MIN and MAX vertex coordinates value, you will be sure to catch the text and dimensions of found polyline on drawing no more.

In the next days I'll try to develop this part too and make some test, I'll keep you informed.

I hope above could help you more.

See attached sample xlsm (with macro inside) and drawing with polyline.

Re: List all polylines, inner texts and dimensions

grobnik — Wed, 10 Nov 2021 19:54:22 GMT

@Anonymous thank you for accepted as solution. Did you try the code? I'm still working on.

Re: List all polylines, inner texts and dimensions

Anonymous — Thu, 11 Nov 2021 10:39:12 GMT

I'm testing but I found another issue.

The guys did not standardized the lines, there are lines and polylines.

The first time I tried your vba it did not get any data, so I found out that they were lines ,,, 😶

Thank you for yout attention, @grobnik I'm trying to adapt your code to identify the line too.

I change the if (If TypeOf Obj Is AcadPolyline Or TypeOf Obj Is AcadLine Then)

But not it is saying that the "object does not accept the property or method" I guess it because of the Obj.Coordinates that cannot be used with line.

Public Sub lista_poly() Dim Myapp As Object Dim MyDwg As AcadDocument Dim Obj As AcadObject Dim Ent As AcadEntity Dim text As AcadText Dim w As Worksheet Dim Ppos() As Double Dim line As AcadLine Dim pontos As Double Dim MySset As AcadSelectionSet Dim FilterType(4) As Integer Dim FilterData(4) As Variant Dim P1(0 To 2) As Double Dim P2(0 To 2) As Double R = 2 Set Myapp = GetObject(, "Autocad.application") Set MyDwg = Myapp.ActiveDocument Sheets(1).Range("B1") = "X" Sheets(1).Range("C1") = "Y" x = 1 For Each Obj In MyDwg.ModelSpace If TypeOf Obj Is AcadPolyline Or TypeOf Obj Is AcadLine Then Line_Pos = Obj.Coordinates For i = 0 To UBound(Line_Pos) Step 2 Sheets(1).Range("B" & R) = Line_Pos(i) Sheets(1).Range("C" & R) = Line_Pos(i + 1) R = R + 1 Next ' GetMaxNumber (Line_Pos) P1(0) = Line_Pos(0) P1(1) = Line_Pos(1) P1(2) = 0 P2(0) = UBound(Line_Pos) - 1 P2(1) = UBound(Line_Pos) P2(2) = 0 On Error Resume Next Set MySset = MyDwg.SelectionSets.Add("MySel") If Err.Number <> 0 Then MyDwg.SelectionSets.Item("MySel").Delete Set MySset = MyDwg.SelectionSets.Add("MySel") End If FilterType(0) = -4 FilterData(0) = "<or" FilterType(1) = 0 FilterData(1) = "TEXT" FilterType(2) = 0 FilterData(2) = "MTEXT" FilterType(3) = 0 FilterData(3) = "DIMENSION" FilterType(4) = -4 FilterData(4) = "or>" 'MySset.Select acSelectionSetWindow, P2, P1, FilterType, FilterData MySset.Select acSelectionSetAll, , , FilterType, FilterData If MySset.Count >= 1 Then For a = 0 To MySset.Count Select Case MySset.Item(a).ObjectName Case "AcDbText" Sheets(1).Range("A" & R) = MySset.Item(a).TextString Case "AcDbRotatedDimension" Debug.Print "DIMENSION ROTATED" Sheets(1).Range("D" & R) = MySset.Item(a).Measurement R = R + 1 End Select Next End If End If Next End Sub

Re: List all polylines, inner texts and dimensions

grobnik — Thu, 11 Nov 2021 10:53:28 GMT

Hi @Anonymous probably the error concern the coordinates obj properties, which should be available for polyline, but not to for line obj type.

Line has StartPoint and EndPoint coordinate reference (3p, double var type) instead "coordinates" of polyline.

You should differentiate the two object found cases and store in an array in case of Line object type.

Bye