Help requested, Best approah to update text

I have a BOM made from individual text entitles.

Example:

4 8 8 40808


Values are:
4 = size
8= feet
8 =inches
40808=number as a whole

I want to create a routine that would update the 3 numbers to the left of
the whole value based upon that text string.
The 4,8,8 values insertion point are an equal distance apart @ 6 11/16" ,
and 8 1/2" from 40808.

If the FEET or INCHES value is less than 10, add 0(Zero)
If INCHES value is 12, set Inches to 0 and add 1 to FEET value

I consider myself still very new to VBA. I have learned a great deal from
this group, but I am not sure of how to approach this, or the code for it.

Ideally, I want the code to prompt the user for text to edit (number as
whole, 40808), then the code would update the numbers to the left
automatically.

Thanks for any help, code, guidance,
Dan

 

Dan,
can you explain this a bit more please?

Is this "4 8 8 40808" in your BOM, or the actual text string in the dwg?

"Ideally, I want the code to prompt the user for text to edit (number as
whole, 40808), then the code would update the numbers to the left automatically."

Again, are we talking about updating your BOM, or the text in the dwg?


Finally,
"If the FEET or INCHES value is less than 10, add 0(Zero)"
why 10 inches?

 

Sorry, fo not being clear. The BOM is just made up of separate text entities
in the CAD drawing.
Dan

 

Dan,
I gathered that much from the first post (that you create the BOM from the text objects).

I'm stlil unclear on:
Is this "4 8 8 40808" in your BOM, or the actual text string in the dwg?

"Ideally, I want the code to prompt the user for text to edit (number as

Perhaps an example would be better?

 

Hope this clears what I am trying to do. Its not very easy to explain,
sorry. Thanks for the assistance!

They are actual text string entitied in the drawing.

Updating the text in the drawing

Example drawing picture and dwg. file provided.

Example would be
4 8 8 = 40808 (zero is to be removed)
4 10 10 = 41010

41208 = (converted by vba) 40508

 

Dan, While you write something
more elegant. this should save
you a few key strokes. didn't
change the blue text, add
if necessary.

gl

Paul

<code>
Option Explicit

Sub oit()
Dim oText As AcadText
Dim oText1 As AcadText
Dim genObject As acadObject
Dim pickPoint, newString

With ThisDrawing
.Utility.GetEntity oText, _
pickPoint, "GrabText"
newString = InputBox("NewString")

For Each genObject In .ModelSpace
If TypeOf genObject Is AcadText Then

Set oText1 = genObject

If oText1.insertionPoint(1) = _
oText.insertionPoint(1) Then

Select Case _
Round(oText1.insertionPoint(0), 0)
Case 8
oText1.TextString = _
Mid(newString, 1, 1)
Case 14
oText1.TextString = _
Mid(newString, 3, 1)
Case 21
oText1.TextString = _
Mid(newString, 5, 1)
End Select

End If

End If

Next genObject

oText.TextString = newString

End With

End Sub
</code>

 

Paul,
I like the way you used the Round function to create selection windows.
Makes for a great quick solution. Here's my contribution... I added a loop
and the logic for converting 12" to 1'.

Code:

Sub oit()
Dim oText As AcadText
Dim oText1 As AcadText
Dim genObject As AcadObject
Dim pickPoint, newString

Dim returnObj As AcadObject
Dim dft As Long, din As Long
Do
On Error Resume Next

With ThisDrawing
.Utility.GetEntity returnObj, _
pickPoint, "Select the MK text object:" & vbCr

If Err <> 0 Then
Err.Clear
Exit Sub
Else

On Error GoTo 0

If TypeOf returnObj Is AcadText Then
Set oText = returnObj
newString = InputBox("NewString", , oText.TextString)

'convert 12" to 1'
dft = Val(Mid(newString, 2, 2))
din = Val(Mid(newString, 4, 2))

If din = 12 Then
din = 0
dft = dft + 1
End If

' if you want to keep the "12" in the MK text then
comment out
'   the following line
newString = Mid(newString, 1, 1) & Format(dft, "00") &
Format(din, "00")

For Each genObject In .ModelSpace
If TypeOf genObject Is AcadText Then

Set oText1 = genObject

If oText1.InsertionPoint(1) = _
oText.InsertionPoint(1) Then

Select Case _
Round(oText1.InsertionPoint(0), 0)
Case 8
oText1.TextString = _
Mid(newString, 1, 1)
Case 14
oText1.TextString = Str(dft)
Case 21
oText1.TextString = Str(din)
End Select
End If
End If
Next genObject
End If
oText.TextString = newString
End If
End With
Loop
End Sub

 

Thank you Mr. Paul Richardson,
WOW! Some very good approaches I did not think of.
I will work on it, and post back soon, Thank you very much for your effort,
upon completion, this will save MANY keystrokes.
Dan

 

Thank you Mr. James Belshan,
I will work on it, and post back soon, Thank you very much for your effort,
upon completion, this will save MANY MANY keystrokes.
Dan

 

Hey James,

Home with a busted leg, one of the good ones...ouch.
Figured I would get him started. How is every little?

Paul

 

I have read the code, ans stepped through it many times. I believe I
understand most of what is going on, but I do not understand the line
"Select Case _
Round(oText1.InsertionPoint(0), 0)"


I did add some lines of code to work with 6 digit mk numbers.
I believe the MID functions were setup for only 5 digit mk numbers.

I ran some tests with the sample drawing provided, and get the following:

Started with values of:

4,8,8,40808

change MK to 50909; outcome = sucess! text changed to 5,9,9,50909

Then

change MK to 61010, outcome sucess! text changed to 6,10,10,61010

Then

change MK to 71111, outcome failed... text changed to 7,10,10,71111

I believe this is happening because we are now updating text with a XX digit
as aposed to a X digit.
5,9,9,50909 changed to 6,10,10,61010 fine because we went from a single
didgit of 9(X) to a double digit of 10(XX),
but if I try to go from double digit 10(XX) to double digit11(XX) it will
fail.

I believe it might have something to do with the line of code I do not
understand.
I am not fully aware of how Cases work yet either. if you could, please
explain to me how this CASE in this code works.

Thank you so much,
Dan

Here is what we have so far:

Code:

Sub oit()
Dim oText As AcadText
Dim oText1 As AcadText
Dim genObject As AcadObject
Dim pickPoint, newString
Dim returnObj As AcadObject
Dim dft As Long, din As Long
Dim MyLen As Variant 'Added

Do
On Error Resume Next

With ThisDrawing
.Utility.GetEntity returnObj, _
pickPoint, "Select the MK text object:" & vbCr

If Err <> 0 Then
Err.Clear
Exit Sub
Else

On Error GoTo 0

If TypeOf returnObj Is AcadText Then
Set oText = returnObj
newString = InputBox("NewString", , oText.TextString)

MyLen = Len(newString) 'Added


If MyLen > 5 Then 'Added
'convert 12" to 1' Added
dft = Val(Mid(newString, 3, 2)) 'Added
din = Val(Mid(newString, 5, 2)) 'Added
Else 'Added
'convert 12" to 1'
dft = Val(Mid(newString, 2, 2))
din = Val(Mid(newString, 4, 2))
End If 'Added

If din = 12 Then
din = 0
dft = dft + 1
End If


If MyLen > 5 Then 'Added
newString = Mid(newString, 1, 2) & Format(dft, "00")
& Format(din, "00") 'Added
Else 'Added
newString = Mid(newString, 1, 1) & Format(dft, "00")
& Format(din, "00")
End If 'Added

For Each genObject In .ModelSpace
If TypeOf genObject Is AcadText Then

Set oText1 = genObject

If oText1.InsertionPoint(1) = _
oText.InsertionPoint(1) Then

Select Case _
Round(oText1.InsertionPoint(0), 0)
Case 8
If MyLen > 5 Then 'Added
oText1.TextString = _
Mid(newString, 1, 2) 'Added
Else 'Added
oText1.TextString = _
Mid(newString, 1, 1)
End If  'Added
Case 14
oText1.TextString = Str(dft)
Case 21
oText1.TextString = Str(din)
End Select
End If
End If
Next genObject
End If
oText.TextString = newString
End If
End With
Loop
End Sub

 

OUCH! Sorry to hear that. Thank you for your help.

 

Your code worked for me, even on 61010 and 71111. I would make sure that
your text object coordinates are correct for the problem ones. Also... if
you want to make your code a little more error-proof, you could have it
catch values > 12, such as 71013... you could make that 11'-1" or just throw
up an error message and not change anything.

The Select Case simply evaluates the X-coord of each Text item's insertion
point, rounded to an integer value. It then executes whichever Case
matches, if any. It's like an IF...ELSEIF...ELSEIF...ENDIF block.

James

<snip>

 

True, it will work fron 61010 to 71111, trouble it when the first number
goes to 2 digits. Follow this sequence: 80808-90909-101010-(problem
here)111111. cant figure out why, the insertion point in center middle so it
does not change based upon text value??

I have added many lines of code for error checking, this apppears to be the
last step to figure out.

Thanks again for trying to help me figure this out,
Dan

 

I modified the code to add extra cases, and it appears to work, but I do not
like to simple add code for a "fix" not knowingth the problem.

Here is code modified

'code snip
Select Case _
Round(oText1.InsertionPoint(0), 0)
Case 7
If MyLen > 5 Then
oText1.TextString = _
Mid(newString, 1, 2)
Else
oText1.TextString = _
Mid(newString, 1, 1)
End If
Case 8
If MyLen > 5 Then
oText1.TextString = _
Mid(newString, 1, 2)
Else
oText1.TextString = _
Mid(newString, 1, 1)
End If
Case 9
If MyLen > 5 Then
oText1.TextString = _
Mid(newString, 1, 2)
Else
oText1.TextString = _
Mid(newString, 1, 1)
End If
Case 13
oText1.TextString = Str(dft)
Case 14
oText1.TextString = Str(dft)
Case 15
oText1.TextString = Str(dft)

Case 20
oText1.TextString = Str(din)
Case 21
oText1.TextString = Str(din)
Case 22
oText1.TextString = Str(din)
End Select
I am almost there,

Dan

 

Well, I learned a few more things with this code. I do appreciate everyone's
help. I have a few more items to figure out why things happen, but this will
save thousands of keystrokes.
I have been wanting to simplyfy this process far to long.

Thank you very much again to everyone involved, Paul, James, and Oberer!

Dan

 

Dan,

AHA! The InsertionPoint(0) is returning the X-coord at the left of the
text, the left-most grip. It changes as the text gets wider and narrower.
The center point is fixed, it's the TextAlignmentPoint (the centered grip).
In the ACAD properties window, look at the PositionX and TextAlignmentX
properties as you change the text to different values. So, in your code,
replace InsertionPoint with TextAlignmentPoint. So when you get to the
2-digit numbers, the text item coordinates started rounding to 7 instead of
8, 13 instead of 14, etc.

This is fine, as long as you understand what it's doing. Basically, after
you pick an MK text, ANY text item that has both the exact same Y-coord,
and an X-coord between 6.5 and 9.49 will be changed.

You can condense your Case statements... instead of having 3 blocks for 7,8,
and 9, you can use
"Case 7 To 9" or "Case 7, 8, 9". Hit F1 on the Case statement to see
examples.

We can tinker with the coordinates to make them as picky as you need them to
be, so you don't miss changes like it was doing, or (worse), change other
text items that you didn't mean to. You can also change them to be
calculated relative to the MK text coordinates, so that the code would work
regardless of where the BOM is on the page.



James

 

Good hit! Thanks. So much to learn....
Dan

 

One more thought, you can put a fuzz-factor into your Y-coordinate
comparison so that your CAD work doesn't have to be so precise for the
routine to do its job.

Code:

If fuzzEq(oText.InsertionPoint(1), oText1.InsertionPoint(1), 0.1) Then


Function fuzzEq(val1 As Variant, val2 As Variant, Optional pFuzz As Double =
0.001) As Boolean
fuzzEq = (Abs(val1 - val2) < pFuzz)
End Function

James

 

Good thought. I was just thinking about that. You already answered my next
question. Thanks. I have learned allot.
Dan