Jump to content

Remove Items From Selection Set


kunekainen

Recommended Posts

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.

Link to comment
Share on other sites

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

  • Like 1
Link to comment
Share on other sites

  • 5 years later...

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...