Remove Items From Selection Set

[kunekainen]

Hi there. I am about to complete my first code for AutoCAD VBA and I have a problem which I couldn't solve it for hours.

 

This is my code:

 

Public Function NumericOnly(s As String) As String
   
   Dim s2 As String
   Dim replace_hyphen As String
   replace_hyphen = " "
   Static re As RegExp
   If re Is Nothing Then Set re = New RegExp
   re.IgnoreCase = True
   re.Global = True
   
   re.Pattern = "[^0-9 ^x ^~]" 'includes space, if you want to exclude space "[^0-9]"
   s2 = re.Replace(s, replace_hyphen)
          
   re.Pattern = "^\s+"
   s2 = re.Replace(s2, vbNullString)
         
   re.Pattern = " \s+"
   NumericOnly = re.Replace(s2, replace_hyphen)
       
End Function


Sub bqtable()


Dim varPt1 As Variant
Dim acTable As AcadTable

Dim ss As AcadSelectionSet
Dim rawtxt As AcadText
Dim temptxt As String

Dim i, j As Integer
Dim x, y As Integer

Const PI As Double = 3.14159

Dim tempdia As Integer
Dim checkerdia As Boolean

Dim weightdia As Double
Dim totalweight As Double
Dim weight As Double

'Load Form
'mainGUI.show

defaultrowh = mainGUI.TextBox2.Text


'create table
varPt1 = ThisDrawing.Utility.GetPoint(, "Select Point")

Set acTable = ThisDrawing.ActiveLayout.Block.AddTable(varPt1, 3, 5, defaultrowh, 30)


acTable.SetText 0, 0, "DONATI METRAJI"
acTable.SetText 1, 0, "Adet"
acTable.SetText 1, 1, "Çap"
acTable.SetText 1, 2, "Boy"
acTable.SetText 1, 3, "Benzer"
acTable.SetText 1, 4, "Agirlik"


'tabloyu doldur
Set ss = ThisDrawing.SelectionSets.Add("SS047")


ss.SelectOnScreen

i = 2
j = 0

weightthin = 0
weightthick = 0
totalweight = 0

For tempdia = 8 To 34 Step 2
     
checkerdia = False
weightdia = 0
       
       For Each rawtxt In ss
           
               temptxt = rawtxt.TextString
                           
               'Büyük Harfe Çevir ve Çap Operatörünü Düzenle
               temptxt = Trim(UCase(Replace(temptxt, mainGUI.TextBox1.Text, "ƒ")))
               
               '/ Varsa Temizle
               If InStr(temptxt, "/") <> 0 Then
                           
                           pos0 = InStr(temptxt, "/")
                           pos1 = InStr(temptxt, "L=")
                           x = pos1 - pos0
                           temptxt = Trim(UCase(Left(temptxt, pos0 - 1) & " L=" & Right(temptxt, Len(temptxt) - pos0 - pos1 + pos0 - 1))) & " "
                                               
                   Else
                                   
                           temptxt = UCase(temptxt) & " "
               End If
               
               
               'Sayıları al ve yazdır
               A = NumericOnly(temptxt)
               Arr = Split(A, " ")
               
               If Arr(1) = tempdia Then
                               
                   checkerdia = True
                   
                   t = 0
                   
                   Do While t <= UBound(Arr)
                   
                       acTable.SetText i, t, Arr(t)
                       t = t + 1
                                           
                   Loop
                   
                      
                   acTable.SetText i, 3, "1"
                   
                   'Mevcut poz için ağırlık hesapla yaz
                   weight = acTable.GetText(i, 0) * PI * (acTable.GetText(i, 1) / 1000) ^ 2 / 4 * acTable.GetText(i, 2) / 100 * acTable.GetText(i, 3) * 7850
                   acTable.SetText i, 4, weight
                   
                   acTable.SetText i, 4, Format(acTable.GetText(i, 4), "#0.0")
                   acTable.SetRowHeight i, defaultrowh
                                   
                   acTable.InsertRows i + 1, defaultrowh, 1
                   
                   'ağırlık güncelle
                   
                   If tempdia = 8 Or tempdia = 10 Or tempdia = 12 Then
                   
                       weightthin = weightthin + weight
                   
                   End If
                                       
                   weightdia = weightdia + weight
                   totalweight = totalweight + weight
                                   
                   'işlenen datayı selection setden çıkar
                   ss.RemoveItems (rawtxt)
                                                                                               
                   i = i + 1
                    
                                       
               
               End If
                 
               
       Next
       
       'Bakılan çap varsa toplam ekle
       If checkerdia = True Then
                   
           acTable.InsertRows i + 1, defaultrowh, 1
                   
           acTable.SetText i, 0, ("Toplam ø" & tempdia)
           acTable.SetText i, 4, weightdia
           acTable.SetText i, 4, Format(acTable.GetText(i, 4), "#0.0")
           
           acTable.MergeCells i, i, 0, 3
           acTable.SetCellAlignment i, 0, acMiddleLeft
           acTable.SetRowHeight i, defaultrowh
           
           
           i = i + 1
                               
       End If
              

Next


ss.Delete


End Sub

The problem is:

 

ss.RemoveItems (rawtxt)

I want the processed item removed from the selection set but I couldn't manage it.

 

Thanks in advance.

[RICVBA]

RemoveItems requires an array of AcadEntity elements. Even if there has to be only one element in it.

So you must add something like what follows:

 

Dim Ent(0) As AcadEntity ' this you can add at the beginning of your code toghether wit other Dim statements

Set Ent(0) = rawTxt 'this line must be added before the following one

ss.RemoveItems Ent ' this line you already have in your code

[kunekainen]

I solved it a few days later and i forgot to modify my message here. Thanks for your help my friend.

[RICVBA]

I solved it a few days later and i forgot to modify my message here. Thanks for your help my friend.

 

you're welcome

[phobo3s]

thank you for help.