Text insertion point

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

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

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.

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'~

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'~

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