kunekainen Posted September 7, 2014 Share Posted September 7, 2014 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. Quote Link to comment Share on other sites More sharing options...
RICVBA Posted September 13, 2014 Share Posted September 13, 2014 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 1 Quote Link to comment Share on other sites More sharing options...
kunekainen Posted September 13, 2014 Author Share Posted September 13, 2014 I solved it a few days later and i forgot to modify my message here. Thanks for your help my friend. Quote Link to comment Share on other sites More sharing options...
RICVBA Posted September 15, 2014 Share Posted September 15, 2014 I solved it a few days later and i forgot to modify my message here. Thanks for your help my friend. you're welcome Quote Link to comment Share on other sites More sharing options...
phobo3s Posted June 5, 2020 Share Posted June 5, 2020 thank you for help. Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.