Sort Texts

[RepCad]

Hi all guys, I'm recently started vba autocad, for my first program I'm going to create a selection set of texts and sort the texts by y coordinate, but I couldn't find a way to sort them by Y coordinate :

 

Dim ss As AcadSelectionSet
Dim FilterType(0) As Integer
Dim FilterData(0) As Variant

 

 Set ss = ThisDrawing.SelectionSets.Add("MySS")

 

  FilterType(0) = 0
  FilterData(0) = "TEXT,MTEXT"

ss.SelectOnScreen FilterType, FilterData

 

Can someone give me a solution?

[PeterPan9720]

15 hours ago, amir0914 said:

Hi all guys, I'm recently started vba autocad, for my first program I'm going to create a selection set of texts and sort the texts by y coordinate, but I couldn't find a way to sort them by Y coordinate :

 

Dim ss As AcadSelectionSet
Dim FilterType(0) As Integer
Dim FilterData(0) As Variant

 

 Set ss = ThisDrawing.SelectionSets.Add("MySS")

 

  FilterType(0) = 0
  FilterData(0) = "TEXT,MTEXT"

 

Can someone give me a solution?

 

Hi AMIR,

first of all, I guess you have to find the select object coordinates for example:

Dim MyObject As AcadEntity
Dim MyCoord() As Double
Dim MyX As Double
Dim MyY As Double
Dim MyZ As Double
Dim ss As AcadSelectionSet
Dim FilterType(0) As Integer
Dim FilterData(0) As Variant
FilterType(0) = 0
FilterData(0) = "TEXT,MTEXT"

Set ss = ThisDrawing.SelectionSets.Add("MySS")

ss.SelectOnScreen FilterType, FilterData

For Each MyObject In ss
    MyCoord = MyObject.InsertionPoint
    MyX = MyCoord(0)
    MyY = MyCoord(1)
    MyZ = MyCoord(2)
Next
ss.Delete

Best Solution could be put in three different arrays and sort by single array, later you can move object inside drawing based upon sorted coordinates.

 

Dim MyX() As Double
Dim MyY() As Double
Dim MyZ() As Double
Dim A As integer
....
'For Each MyObject In ss
   ' MyCoord = MyObject.InsertionPoint
   ' MyX = MyCoord(0)
   ' MyY = MyCoord(1)
  '  MyZ = MyCoord(2)
'Next
A = 1
ReDim MyX(ss.Count) ' Array first Dimension was uncounted Dim MyX() As Double
ReDim MyY(ss.Count) ' Array first Dimension was uncounted Dim MyY() As Double
ReDim MyZ(ss.Count) ' Array first Dimension was uncounted Dim MyZ() As Double

For Each MyObject In ss
    MyCoord = MyObject.InsertionPoint
    MyX(A) = MyCoord(0)
    MyY(A) = MyCoord(1)
    MyZ(A) = MyCoord(2)
    A = A + 1
Next
ss.Delete

		iFirstRow = LBound(MyY)
        iLastRow = UBound(MyY)

        For i = iFirstRow To iLastRow - 1
            For j = i + 1 To iLastRow
                If MyY(i) > MyY(j) Then
                    varTemp = MyY(j)
                    MyY(j) = MyY(i)
                    MyY(i) = varTemp
                End If
            Next j
        Next i

So now you have Y coordinates ordered by lower to higher.

Edited December 21, 2019 by PeterPan9720

[RepCad]

Hi Peter,

Thank you so much for replying, that was great, but the variable MyY(A) started from 1, it means MyY(0) not exist  in the array and LBound(MyY) is 0, so why did you use MyY(0) in this part of code : (because iFirstRow  is zero)

 

 

For i = iFirstRow To iLastRow - 1
            For j = i + 1 To iLastRow
                If MyY(i) > MyY(j) Then
                    varTemp = MyX(j)
                    MyY(j) = MyY(i)
                    MyY(i) = varTemp
                End If
            Next j
        Next i

[PeterPan9720]

Hi,

You are right, It's a quickly code I didn't check completely, just to give you a way to follow.

Try to fix starting A from 0, or better using where needs, as index cycles,  the selection set count object (ss.Count) just to avoid shift.

 

Will follow the way to insert text in the drawing or reorder the object postion (please let me know what do you need to do)

I hope that at least the above code helps you in a first step.

 

Bye

 

[RepCad]

17 hours ago, PeterPan9720 said:

Hi,

You are right, It's a quickly code I didn't check completely, just to give you a way to follow.

Try to fix starting A from 0, or better using where needs, as index cycles,  the selection set count object (ss.Count) just to avoid shift.

 

Will follow the way to insert text in the drawing or reorder the object postion (please let me know what do you need to do)

I hope that at least the above code helps you in a first step.

 

Bye

 

Thank you so much, your guidance was very helpful for me, and for the next step I'm going to insert the sorted texts and export the entity of them in  notepad. my main problem is that not exist many source to learn vba autocad while there are lots of functions and forums to ask question about Autolisp. the books which I bought about vba only have simple codes for example how to make make texts or selection set. 

In any case I'm not stopping. Thanks again for your sincere help. (my English is weak ,sorry for if I made a mistake in my typing) 

[PeterPan9720]

Hi Amir,

Doesn't matter for your English, concerning VBA learning there are a lot of book, also available on line.

But I suggest to learn generic VBA (excel for example) and then try to use Autocad, because the main VBA structure it's always the same.

The difference consist of specific functionality related to Autocad (also for Autocad there are a lot of difference between Autocad Mechanical, Autocad Electric, or general use).

 

Again on your code, for Adding text in a drawing you could use :

ThisDrawing.ModelSpace.AddText ss.Item(A).TextString, MyNewCoords, 5 

Where:

Thisdrawing.modelspace means model space drawing

SS.item(XX).textstring means the string content of selected object

MyNewCoords means the new coordinates it's an array composed by X, Y, Z coordinates (long type)

5 it's the text height.

 

Please note  before adding a text into ModelSpace you have to define default text style, or write a code defining default text style properties.

Concerning the export I suggest to use a temporary text file and later import into notepad or excel or some other text reader.

 

A typical code could be:

Open "TESTFILE.TXT" For Output As #1    ' Open file for output, in case insert also path c:\xxx\xxxx\ before text file name always inside the " ", or you can use a MyPath var inserting your specific path and then MyPath & "TESTFILE.TXT" .

Print #1, "This is a test"    ' Print text or a variable to file.

Close #1 ' Close before reopening.

After you can use everywhere.

As alternative there is possibility to exchange data directly with excel, but it's more complex.

I hope this help you more

Bye

Edited December 22, 2019 by PeterPan9720

[PeterPan9720]

Hi Amir,

here your code selection, reorder and move text on drawing and write on text file

Sub PeterXX()
Dim MyObject As AcadEntity
Dim MyCoord() As Double
Dim MyNewCoords() As Double
Dim A As Integer
Dim MyX() As Double
Dim MyY() As Double
Dim MyZ() As Double
Dim ss As AcadSelectionSet
Dim FilterType(0) As Integer
Dim FilterData(0) As Variant
FilterType(0) = 0
FilterData(0) = "TEXT,MTEXT"

Set ss = ThisDrawing.SelectionSets.Add("MySsS")

ss.SelectOnScreen FilterType, FilterData
ReDim MyX(ss.Count - 1)
ReDim MyY(ss.Count - 1)
ReDim MyZ(ss.Count - 1)

A = 0
For Each MyObject In ss
    MyCoord = MyObject.InsertionPoint
    MyX(A) = MyCoord(0)
    MyY(A) = MyCoord(1)
    MyZ(A) = MyCoord(2)
    A = A + 1
Next


iFirstRow = LBound(MyY)
iLastRow = UBound(MyY)

        For i = iFirstRow To iLastRow - 1
            For j = i + 1 To iLastRow
                If MyY(i) > MyY(j) Then
                    varTemp = MyY(j)
                    MyY(j) = MyY(i)
                    MyY(i) = varTemp
                End If
            Next j
        Next i
        
ReDim MyNewCoords(0 To 2)
A = 0
Open "C:\Users\Utente\Documents\TESTFILE.TXT" For Output As #1
    For Each MyObject In ss
        MyNewCoords(0) = MyX(A)
        MyNewCoords(1) = MyY(A)
        MyNewCoords(2) = MyZ(A)
        ss.Item(A).InsertionPoint = MyNewCoords
        ThisDrawing.ModelSpace.AddText ss.Item(A).TextString, MyNewCoords, 5
        Print #1, "VALUE  " & A & " = " & ss.Item(A).TextString
        A = A + 1
    Next
'
Close #1
ss.Delete
End Sub

Please note:

same text previously selected will be added in the same position of new order and in the same time object selected will be moved if not required "play" with below code

ss.Item(A).InsertionPoint = MyNewCoords
ThisDrawing.ModelSpace.AddText ss.Item(A).TextString, MyNewCoords, 5

See file attached

Module3.basBye

Edited December 22, 2019 by PeterPan9720

[PeterPan9720]

Sorry to insist with code, but today I have some time to spent with joking with visual basic, and cad.

Here attached code for export data directly in an Excel workbook.

You have to start the VBA Code with Excel program opened, and in any case will be created an addition cartel.

Attached drawing consist of 4 text aligned on y axis I used for test, if you are not able to open I'll save with oldest Cad release.

if you have a special own excel form to fill, VBA module could be fixed in order to write data in correct columns and/or rows.

 

I guess now you have a lot of work to do.... 

Bye

Module4.bas TestDrawing1.dwg

[PeterPan9720]

Hi AMIR just to give you some extra gift.... for Xmas  here a simply code to be written inside previously excel file produced, in order to have zoom on selected coordinates object.

I mean:

- Inside excel file produced with your text info, you have also the object coordinates..... how to do the opposite if you have a big drawing, so how to find excel selected text inside wide drawing, may you have hundred text... how to find quickly inside the drawing.

- If you open the excel file, select first x coordinates cell and run the below code:

Sub Opendwg()
 
    Dim acadApp As Object
    Dim acadDoc As Object
    Dim MyCenter(0 To 2) As Double
    Dim MyMag As Double

 'Check if AutoCAD application is open. If is not opened create a new instance and make it visible.
    Set acadApp = GetObject(, "AutoCAD.Application")
    Set acadDoc = acadApp.ActiveDocument

  '  If acadApp Is Nothing Then
  '     Set acadApp = CreateObject("AutoCAD.Application")
  '      acadApp.Visible = True
   ' End If
   
   CellsX = ActiveCell.Value
   YCol = ActiveCell.Column + 1
   CellsY = Cells(ActiveCell.Row, YCol).Value
   ZCol = ActiveCell.Column + 2
   CellsZ = Cells(ActiveCell.Row, ZCol).Value
   
   MyCenter(0) = CellsX
   MyCenter(1) = CellsY
   MyCenter(2) = CellsZ
    
    MyMag = 5
    acadDoc.Application.ZoomCenter MyCenter, MyMag

End Sub

The above code center the drawing zoom on coordinates indicated in the excel file (columns A to C, equal to X,Y,Z value).

First step open the CAD file as Object inside EXCEL, follow with hyphens ' commented, if not open create a new empty drawing, but this will be not useful for your project (just for your info).

The main zoom option it's made with ZoomCenter function, where you have to pass the coordinates as double format and array sized 0 to 2 (MyCenter (0 to 2) As Double), and a magnification value settled to 5 but you can change (MyMag As Double).

 

Be careful, all code I sent you there are no cross check, so if you select a different cell from those inside the file, of course the routine give an error, or if you do not select a text inside Autocad Drawing the same.

 

Bye

PorvaDrawing1.xlsx

Edited December 23, 2019 by PeterPan9720

[RepCad]

Hi Peter,

Wov, that was great, I did them in vba and I also extended your codes a bit, I added some codes for example text color, text style, and also text added by get point from user and export notepad by file dialog.

I have worked excel vba for ages, and it's really exciting because I could insert text in autocad by excel vba for first time with this codes which you presented :

 

 Dim acadApp As Object
    Dim acadDoc As Object

    Set acadApp = GetObject(, "AutoCAD.Application")
    Set acadDoc = acadApp.ActiveDocument

  '     Set acadApp = CreateObject("AutoCAD.Application")
  '      acadApp.Visible = True
   ' End If

 

[PeterPan9720]

Hi Amir,
I hope I have been not so much boring with several reply, and I guess my code opened you a big possibility to use code as your needs and more.
Let me know if you need something else.

 

 

Edited December 24, 2019 by PeterPan9720

[BIGAL]

peterpan you can check if excel is open,  if not open a new session or open an existing xls file. Whilst this is lisp it the same method for checking in VBA.

 

There should be examples of Bubblesort in vba which could be useful I have a recursive one in lisp for up to 5 levels say num,x,y,z,code. Like excel columns sortGetExcel.lsp

[PeterPan9720]

Hi @BIGAL, thank you for your CODE, I have not so familiarity with lisp language, as I have with VBA, however the scope of code was to give a path, a way to follow, some suggestions to AMIR, I don't know exactly what needs he want to do. Once he had a starting code of course he can expand the procedure functionality writing some other code.

Initially he asked "....Hi all guys, I'm recently started vba autocad, for my first program I'm going to create a selection set of texts and sort the texts by y coordinate, but I couldn't find a way to sort them by Y coordinate :..." , seems he received more help than he required:

• He has a code to retrive object coordinates, first step in order to get the object coordinates and later sort by Y coordinate.
• He has a code to sort the selected text by Y coordinate and redraw the same on drawing
• He has a code for exporting selected text on drawing into a text file readable by a notepad
• He has a code for exporting in Excel selected text, relative coordinates, and some other object information.

I guess he has now more opportunities to manage own drawing automation compared with starting request.

 

Thank you again, bye.

 

Edited January 2, 2020 by PeterPan9720

[RepCad]

On 1/2/2020 at 9:57 AM, PeterPan9720 said:

Hi @BIGAL, thank you for your CODE, I have not so familiarity with lisp language, as I have with VBA, however the scope of code was to give a path, a way to follow, some suggestions to AMIR, I don't know exactly what needs he want to do. Once he had a starting code of course he can expand the procedure functionality writing some other code.

Initially he asked "....Hi all guys, I'm recently started vba autocad, for my first program I'm going to create a selection set of texts and sort the texts by y coordinate, but I couldn't find a way to sort them by Y coordinate :..." , seems he received more help than he required:

• He has a code to retrive object coordinates, first step in order to get the object coordinates and later sort by Y coordinate.
• He has a code to sort the selected text by Y coordinate and redraw the same on drawing
• He has a code for exporting selected text on drawing into a text file readable by a notepad
• He has a code for exporting in Excel selected text, relative coordinates, and some other object information.

I guess he has now more opportunities to manage own drawing automation compared with starting request.

 

Thank you again, bye.

 

Hi PeterPan9720, 

Your codes were very useful for me to start vba programming in Autocad . after your help and guidance I have wrote lots of my needed program with vba Autocad and also excel, it is amazing that we can connect Autocad and Excel with vba because now I can draw in Autocad from Excel !!!

Now, I have a question, is it possible to add new tab or ribbon for run our vba codes?? it is simple to run Autolisp program in autocad, but there is no command for run vba codes. I have to open .bas code in autocad and run it manually, so it's not very interesting. do have any way to do this easilly?

 

Thanks in advanced.

 

Edited April 18, 2020 by amir0914

[PeterPan9720]

30 minutes ago, amir0914 said:

Hi PeterPan9720, 

Your codes were very useful for me to start vba programming in Autocad . after your help and guidance I have wrote lots of my needed program with vba Autocad and also excel, it is amazing that we can connect Autocad and Excel with vba because now I can draw in Autocad from Excel !!!

Now, I have a question, is it possible to add new tab or ribbon for run our vba codes?? it is simple to run Autolisp program in autocad, but there is no command for run vba codes. I have to open .bas code in autocad and run it manually, so it's not very interesting. do have any way to do this easilly?

 

Thanks in advanced.

 

Hi @amir0914 I'm happy hearing that my code helps you more,

here below a link where explained how you can recall a procedure by command line

https://forums.autodesk.com/t5/visual-basic-customization/calling-vba-macro-from-command-line-or-button/td-p/2740073

Mainly the trick is to create a new command that recall macro inside the dvb, as alternative you can autoload your entire dvb procedure whenever autocad will be open (not a specific drawing but simply open autocad), and in the same way by command line recall your procedure. You should try I'm not so expert for this part.

 

Bye

[BIGAL]

Look up help vabload and vbarun you can just run a vba from a toolbar menu command line etc.

 

[Drainage schedule]^C^C(vl-vbaload "P:/AutoDESK/VBA/Drainage.dvb") (vl-vbarun "Drainage")