Nima1376 Posted December 3, 2009 Posted December 3, 2009 Hi I want exports numeric text's insertion points to individual arrays , but my code for this task returns : Run-time error '451': I check it every time and againe it returns the same massage , I don't knw why ? please help me . thanks Private Sub CommandButton1_Click() Dim numx1(5000), numy1(5000), numz1(5000) As Double Dim num1(5000), num2(5000) As Integer Dim elem As Acadtext j = 0 For Each elem In ThisDrawing.ModelSpace num1(j) = Val(elem.TextString) numx1(j) = elem.InsertionPoint(0) ===> ? numy1(j) = elem.InsertionPoint(1) numz1(j) = elem.InsertionPoint(2) j = j + 1 MsgBox " NUmber of your numric strings is : " & j MsgBox " You can go to secon steps and use of insertion points coordinates " End Sub Quote
Nima1376 Posted December 7, 2009 Author Posted December 7, 2009 HiI want exports numeric text's insertion points to individual arrays , but my code for this task returns : Run-time error '451': I check it every time and againe it returns the same massage , I don't knw why ? please help me . thanks Private Sub CommandButton1_Click() Dim numx1(5000), numy1(5000), numz1(5000) As Double Dim num1(5000), num2(5000) As Integer Dim elem As Acadtext j = 0 For Each elem In ThisDrawing.ModelSpace num1(j) = Val(elem.TextString) numx1(j) = elem.InsertionPoint(0) ===> ? numy1(j) = elem.InsertionPoint(1) numz1(j) = elem.InsertionPoint(2) j = j + 1 MsgBox " NUmber of your numric strings is : " & j MsgBox " You can go to secon steps and use of insertion points coordinates " End Sub isn't any body here that who know autocad vba ? I want adding two numbers automaticaly by a vb code . my problem is like that cadman2009 but I don't know lisp and it's programming . please help me . if my numbers were like cadman projection , so I will use alanjt lisp code . his code dont work with 3 and 1 number , just work with 4 and 2 numbers. Quote
fixo Posted December 7, 2009 Posted December 7, 2009 isn't any body here that who know autocad vba ?I want adding two numbers automaticaly by a vb code . my problem is like that cadman2009 but I don't know lisp and it's programming . please help me . if my numbers were like cadman projection , so I will use alanjt lisp code . his code dont work with 3 and 1 number , just work with 4 and 2 numbers. You need to cast AcadEntity first then check objectname property i.e.: Private Sub CommandButton1_Click() Dim numx1(5000), numy1(5000), numz1(5000) As Double Dim num1(5000), num2(5000) As Integer dim oent as AcadEntity Dim elem As Acadtext j = 0 For Each oent In ThisDrawing.ModelSpace If Typeof oent is AcadText then '<-- check on desired objectname set elem=oent num1(j) = Val(elem.TextString) numx1(j) = elem.InsertionPoint(0) ===> ? numy1(j) = elem.InsertionPoint(1) numz1(j) = elem.InsertionPoint(2) j = j + 1 end if MsgBox " NUmber of your numric strings is : " & j MsgBox " You can go to secon steps and use of insertion points coordinates " next oent End Sub ~'J'~ Quote
cadman2009 Posted December 7, 2009 Posted December 7, 2009 You need to cast AcadEntity first then checkobjectname property i.e.: Private Sub CommandButton1_Click() Dim numx1(5000), numy1(5000), numz1(5000) As Double Dim num1(5000), num2(5000) As Integer dim oent as AcadEntity Dim elem As Acadtext j = 0 For Each oent In ThisDrawing.ModelSpace If Typeof oent is AcadText then '<-- check on desired objectname set elem=oent num1(j) = Val(elem.TextString) numx1(j) = elem.InsertionPoint(0) ===> ? numy1(j) = elem.InsertionPoint(1) numz1(j) = elem.InsertionPoint(2) j = j + 1 end if MsgBox " NUmber of your numric strings is : " & j MsgBox " You can go to secon steps and use of insertion points coordinates " next oent End Sub ~'J'~ Dear sir I'm cadman . I read this post and have modified your codes as bellow . its work correctly (please see msgbox when they appear) but at the final step when it want writes result numbers on screen an error occurs , I'm tired and must go to work , please reform it may solve nima's problem . I test it on screen with 7 points . thanks - until tomorrow Private Sub CommandButton1_Click() Dim numx1(50), numy1(50), numz1(50) As Double Dim numx2(50), numy2(50), numz2(50), num(50) As Double Dim num1(50), num2(50) As Integer Dim oent As AcadEntity Dim elem As AcadText Dim strnum(50) As String j = 0 k = 0 For Each oent In ThisDrawing.ModelSpace If ((TypeOf oent Is AcadText) Or (TypeOf oent Is AcadMText)) Then Set elem = oent If ((Val(elem.TextString)) >= 1000 And (Val(elem.TextString)) num1(j) = Val(elem.TextString) numx1(j) = elem.InsertionPoint(0) numy1(j) = elem.InsertionPoint(1) numz1(j) = elem.InsertionPoint(2) j = j + 1 ElseIf ((Val(elem.TextString)) >= 0 And (Val(elem.TextString)) num2(k) = Val(elem.TextString) numx2(k) = elem.InsertionPoint(0) numy2(k) = elem.InsertionPoint(1) numz2(k) = elem.InsertionPoint(2) k = k + 1 End If Else End If Next oent MsgBox " NUmber of your 4digit strings is : " & j & " NUmber of your 2digit strings is : " & k MsgBox " You can go to secon steps and use of insertion points coordinates " For i = 0 To (j - 1) num(i) = num1(i) + (num2(i) * 0.01) strnum(i) = Str(num(i)) MsgBox "mum" & i & "=" & strnum(i) Next i '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ Dim txtObj As AcadText Dim textstrf As String Dim inspoint(0 To 2), hi As Double Dim layObj As AcadLayer Set layObj = ThisDrawing.Layers.Add("Combined_Elevation") ThisDrawing.ActiveLayer = layObj layObj.color = acGreen For i = 1 To 1 inspoint(0) = (numx1(i) + numx2(i)) * 0.5 inspoint(1) = (numy1(i) + numy2(i)) * 0.5 inspoint(2) = (numz1(i) + numz2(i)) * 0.5 hi = 1.5 textstrf = strnum(i) Set txtObj = ThisDrawing.ModelSpace.AddText(textstrf, inspoint, hi) txtObj.Layer = "Combined_Elevation" txtObj.color = acByLayer Next i End Sub Quote
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.