Changing Dtext with VBA

[Anonymous]

Hello.

What I'm trying to do is change some existing text with what the user types
into a TextBox. I don't want to look for certain text and replace it. I know
the coordinates of the text that I want to change. I figured it would be
easier to change existing text that is already set on the correct layer,
style, height, width, and so on, than it would be to set all that with code.

Been searching here and the internet, but all I keep finding is people
wanting to search for certain text and then replace it, without opening the
dwg. Or they are using GetEnity. Which that seems to ask the user to select
the enity.

What I'm envisioning is the user will start a new drawing with the template,
then click a button and a UserForm will pop up that has TextBoxes, the user
will then fill in the job number, name, site address, and so on. After the
user has type in the information, they will then click a CommandButton. Then
VBA will go to the right text, based on which TextBox the user entered data
in, and change the existing text to what the user entered in the TextBox.
There will be one TextBox for each text to change.

Can anybody help me on this, or at least give me a push in the right
direction?

Thanks

[Anonymous]

Hi Larry,

I'd recommend making a selection set, selecting all and filtering on the coordinates Or making a selection set, selecting by a window or window crossing calculated by the known coordinates of the text. And then setting the selection set contents (should only be one item) to a acadtext object. Then it's just a matter of making myText.Text = UserForm.TextBox1.Text

[Anonymous]

Hello.

ya I was thinking that i would have to make a
selectionset.

This is what I have so far.

[code]

  Dim TxtObj As AcadText
  Dim P(0 To
2) As Double
  Dim TxtStr As String
  Dim ssetObj As
AcadSelectionSet
  Set ssetObj =
ThisDrawing.SelectionSets.Add("SSET1")
  P(0) = 0: P(1) = 0: P(2) =
0
  ssetObj.SelectAtPoint P

[/code]

This creates and names the SelectionSet. Then adds
the text, at a certain point, to the SelectionSet. Then I don't know what to do.
I have never had the privaledge of working with SelectionSets. I don't even know
if what I have so far will even work.

I was looking around in the object Browser and
found the SelectAtPoint, but I'm not seeing anything about filtering by the
coordinates.

[Anonymous]

[code]

  Dim TxtObj As AcadText
  Dim
InstPT(0 To 2) As Double
  Dim TxtStr As String
  Dim ssetObj As
AcadSelectionSet
  Set ssetObj =
ThisDrawing.SelectionSets.Add("SSET1")
  InstPT(0) = 0: InstPT(1) = 0:
InstPT(2) = 0
  ssetObj.SelectAtPoint InstPT
  For Each TxtObj
In ssetObj
  If InStr(TxtObj.InsertionPoint, InstPT) > 0
Then
     TxtStr = JobName.Value
  End
If

[/code]

Thsi is what I came up with, but can't get it to
work. Keep getting mismatch error.

[Anonymous]

almost... this seems to work

[code]
Sub test()


Dim TxtObj As AcadText
Dim InstPT(0 To 2) As Double
Dim TxtStr As String
Dim ssetObj As AcadSelectionSet
Set ssetObj = ThisDrawing.SelectionSets.Add("123sdf")
InstPT(0) = 0: InstPT(1) = 0: InstPT(2) = 0
ssetObj.SelectAtPoint InstPT
For Each TxtObj In ssetObj
TxtObj.textString = "234432" ' or jobname.text
Next
ssetObj.delete
End Sub
[/code]

[Anonymous]

<code>

Private Sub CommandButton1_Click()
  Dim
TxtObj As AcadText
  Dim InstPT(0 To 2) As Double
  InstPT(0) =
0: InstPT(1) = 0: InstPT(2) = 0
  Dim TxtStr As String
  Dim
acSelectSet As AcadSelectionSet
  Dim acSelectSets As
AcadSelectionSets
  Set acSelectSets =
ThisDrawing.SelectionSets
     For Each acSelectSet In
acSelectSets
         If
acSelectSet.Name = "SSET1"
Then
           
acSelectSets.Item("SSET1").Delete
        
End If
     Exit For
    
Next
  Set acSelectSet = acSelectSets.Add("SSET1")
 
acSelectSet.SelectAtPoint InstPT
  For Each TxtObj In
acSelectSet
    TxtObj.TextString =
JobName.Value
    Next
   
acSelectSet.Delete
End Sub

</code>

Yup. Looks like i was close. This is what I got to
work. I changed some of the names because I wasn't able to keep things
staight.

THANK YOU!!

[Anonymous]

Well it worked once. Now it only works sometimes.
Any ideas as to why.

[Anonymous]

Never mind. I got it to work.

I was running through the editor when it wouldn't
work. When I added a Module and created a Toolbar Button and assigned it a
macro, then run it in AutoCAD. It works everytime. So far. Fingers
crossed.

style="PADDING-RIGHT: 0px; PADDING-LEFT: 5px; MARGIN-LEFT: 5px; BORDER-LEFT: #000000 2px solid; MARGIN-RIGHT: 0px">

"Larry" <-> wrote in message
href="news:6120039@discussion.autodesk.com">news:6120039@discussion.autodesk.com...

Well it worked once. Now it only works sometimes.
Any ideas as to why.

[Anonymous]

Well I thought I had it. This is getting
REALLY frustrating. Who would of thought something as simple as
changing some text would be so complicated.

Whats happening is when I go to change a different
line of text, it wont go to the proper place. It just keep changing the same
line of text.

Is the only way VBA can change text is if it is in
a selection set?

This is the code for the floor
sheathing

<code>

Private Sub cgTextFlSheathing()
  If
obFLSheathing58.Value = True Then
      Dim TxtObj
As AcadText
      Dim InstPT(0 To 2) As
Double
      InstPT(0) = 1890: InstPT(1) = 414:
InstPT(2) = 0
      Dim TxtStr As
String
      Dim acSelectSet As
AcadSelectionSet
      Dim acSelectSets As
AcadSelectionSets
      Set acSelectSets =
ThisDrawing.SelectionSets
      For Each acSelectSet
In acSelectSets
         If
acSelectSet.Name = "SSET1"
Then
           
acSelectSets.Item("SSET1").Delete
        
End If
      Exit
For
      Next
      Set
acSelectSet = acSelectSets.Add("SSET1")
     
acSelectSet.SelectAtPoint InstPT
      For Each
TxtObj In acSelectSet
      TxtObj.TextString =
Label9.Caption
     
Next
     
ThisDrawing.SelectionSets.Item("SSET1").Delete
  End If
  If
obFLSheathing34.Value = True Then
     InstPT(0) = 1890:
InstPT(1) = 414: InstPT(2) = 0
     Set acSelectSets =
ThisDrawing.SelectionSets
       For Each
acSelectSet In acSelectSets
        
If acSelectSet.Name = "SSET1"
Then
           
acSelectSets.Item("SSET1").Delete
        
End If
     Exit For
    
Next
  Set acSelectSet = acSelectSets.Add("SSET1")
 
acSelectSet.SelectAtPoint InstPT
  For Each TxtObj In
acSelectSet
    TxtObj.TextString =
Label10.Caption
    Next
   
ThisDrawing.acSelectSet.Delete
    End If
End
Sub

</code>

This works, but when I add the code for the
underlayment

<code>

Private Sub cgTextFlUnder()
  If
obFLUnderNone.Value = True Then
       Dim
TxtObj As AcadText
       Dim intPoint(0 To 2)
As Double
       intPoint(0) = 1890:
intPoint(1) = 427: intPoint(2) = 0
       Dim
acSelectSet As AcadSelectionSet
       Dim
acSelectSets As AcadSelectionSets
       Set
acSelectSets = ThisDrawing.SelectionSets
      
For Each acSelectSet In
acSelectSets
         If
acSelectSet.Name = "SSET1"
Then
           
acSelectSets.Item("SSET1").Delete
        
End If
     Exit For
    
Next
  Set acSelectSet = acSelectSets.Add("SSET1")
 
acSelectSet.SelectAtPoint intPoint
  For Each TxtObj In
acSelectSet
    TxtObj.TextString =
Label13.Caption
    Next
   
acSelectSet.Delete
    End If
  If obFLUnder38.Value =
True Then
     intPoint(0) = 1890: intPoint(1) = 427:
intPoint(2) = 0
     Set acSelectSets =
ThisDrawing.SelectionSets
       For Each
acSelectSet In acSelectSets
        
If acSelectSet.Name = "SSET1"
Then
           
acSelectSets.Item("SSET1").Delete
        
End If
     Exit For
    
Next
  Set acSelectSet = acSelectSets.Add("SSET1")
 
acSelectSet.SelectAtPoint intPoint
  For Each TxtObj In
acSelectSet
    TxtObj.TextString =
Label11.Caption
    Next
   
acSelectSet.Delete
    End If
End Sub

</code>

It will only change the text at the point defined
in the floor sheathing. I have even tried using different names for the
insertion points, but that didn't work either. What is going on?

Help please?

Is there no way to access the ddedit command,
besides using the sendcommand?

[Anonymous]

Hi Larry,

Add "Option Explicit" to the top of every Module and Form code in your
project, then run the [Debug][Compile] command and find and fix the
errors in the code.

Then note that you are hard coding the location of your InstPt variable
so that it can only assume a limited range of values, then selecting
only objects at that point. If there is no part of the text at those
points then you will have nothing selected.

Look at using acSelectionSetWindow to select the text you want, or
selecting all the text and checking the insertion point of each item to
locate the ones which interest you.


acSelectSet.Select acSelectionSetWindow, PtLL, PtUR, FilterType,
FilterData



The method is fully documented with sample code in the help files.

Regards


Laurie Comerford

Larry wrote:
> Well I thought I had it. This is getting *REALLY *frustrating. Who would
> of thought something as simple as changing some text would be so
> complicated.
>
> Whats happening is when I go to change a different line of text, it wont
> go to the proper place. It just keep changing the same line of text.
> Is the only way VBA can change text is if it is in a selection set?
>
> This is the code for the floor sheathing
>
> Private Sub cgTextFlSheathing()
> If obFLSheathing58.Value = True Then
> Dim TxtObj As AcadText
> Dim InstPT(0 To 2) As Double
> InstPT(0) = 1890: InstPT(1) = 414: InstPT(2) = 0
> Dim TxtStr As String
> Dim acSelectSet As AcadSelectionSet
> Dim acSelectSets As AcadSelectionSets
> Set acSelectSets = ThisDrawing.SelectionSets
> For Each acSelectSet In acSelectSets
> If acSelectSet.Name = "SSET1" Then
> acSelectSets.Item("SSET1").Delete
> End If
> Exit For
> Next
> Set acSelectSet = acSelectSets.Add("SSET1")
> acSelectSet.SelectAtPoint InstPT
> For Each TxtObj In acSelectSet
> TxtObj.TextString = Label9.Caption
> Next
> ThisDrawing.SelectionSets.Item("SSET1").Delete
> End If
> If obFLSheathing34.Value = True Then
> InstPT(0) = 1890: InstPT(1) = 414: InstPT(2) = 0
> Set acSelectSets = ThisDrawing.SelectionSets
> For Each acSelectSet In acSelectSets
> If acSelectSet.Name = "SSET1" Then
> acSelectSets.Item("SSET1").Delete
> End If
> Exit For
> Next
> Set acSelectSet = acSelectSets.Add("SSET1")
> acSelectSet.SelectAtPoint InstPT
> For Each TxtObj In acSelectSet
> TxtObj.TextString = Label10.Caption
> Next
> ThisDrawing.acSelectSet.Delete
> End If
> End Sub
>
>
> This works, but when I add the code for the underlayment
>
> Private Sub cgTextFlUnder()
> If obFLUnderNone.Value = True Then
> Dim TxtObj As AcadText
> Dim intPoint(0 To 2) As Double
> intPoint(0) = 1890: intPoint(1) = 427: intPoint(2) = 0
> Dim acSelectSet As AcadSelectionSet
> Dim acSelectSets As AcadSelectionSets
> Set acSelectSets = ThisDrawing.SelectionSets
> For Each acSelectSet In acSelectSets
> If acSelectSet.Name = "SSET1" Then
> acSelectSets.Item("SSET1").Delete
> End If
> Exit For
> Next
> Set acSelectSet = acSelectSets.Add("SSET1")
> acSelectSet.SelectAtPoint intPoint
> For Each TxtObj In acSelectSet
> TxtObj.TextString = Label13.Caption
> Next
> acSelectSet.Delete
> End If
> If obFLUnder38.Value = True Then
> intPoint(0) = 1890: intPoint(1) = 427: intPoint(2) = 0
> Set acSelectSets = ThisDrawing.SelectionSets
> For Each acSelectSet In acSelectSets
> If acSelectSet.Name = "SSET1" Then
> acSelectSets.Item("SSET1").Delete
> End If
> Exit For
> Next
> Set acSelectSet = acSelectSets.Add("SSET1")
> acSelectSet.SelectAtPoint intPoint
> For Each TxtObj In acSelectSet
> TxtObj.TextString = Label11.Caption
> Next
> acSelectSet.Delete
> End If
> End Sub
>
> It will only change the text at the point defined in the floor
> sheathing. I have even tried using different names for the insertion
> points, but that didn't work either. What is going on?
> Help please?
>
> Is there no way to access the ddedit command, besides using the sendcommand?

[Anonymous]

Hi Larry,

Unless your text has numerous justifications, styles, heights & rotations, it may be alot easier and make your code more legible to maybe use the AddText method.

[Anonymous]

Thanks for the reply. I think I am just going to do the addtext and not
worry about editing text. Later on I will revisit this and try to get it to
where it edits the text. Been told I have been spending to much time on this
and need to move on.
Again Thanks.

[Anonymous]

I have to agree with you 100% about the addtext.
Played with that a little bit and got it to do exactly what I wanted it to do
with a little bit of code. I tought it would be easier to edit existing then add
new, but I was wrong. Boy was I ever wrong.

Thanks for all the help.

style="PADDING-RIGHT: 0px; PADDING-LEFT: 5px; MARGIN-LEFT: 5px; BORDER-LEFT: #000000 2px solid; MARGIN-RIGHT: 0px">

<cadger> wrote in message
href="news:6126638@discussion.autodesk.com">news:6126638@discussion.autodesk.com...

Hi
Larry, Unless your text has numerous justifications, styles, heights &
rotations, it may be alot easier and make your code more legible to maybe use
the AddText method.

[Anonymous]

Well it took over a week to try and figure out how
to edit text with vba and still don't have the results I'm looking for. It has
taken less than a day to accomplish what I wanted by adding text.

Lesson learned. Never try to edit anything with
VBA. Delete it and start new. Much easier.

[Anonymous]

It is absolutely possible, you can even change text in anonymous blocks!!
DText gives you a range of separate "AcDbText"'s, depending on the fontsize it will have it's own sentence-distance.
Problem is ofcourse that you don't know which text is which, unless you know what text should be updated to what.
My guess would be to construct a organized set of Text-objects, for instance in a Block, as separate texts or as attributes,
or each text in it's own layer or you can use "Fields". If the contained text is in Unicode, you will have to update with text formatted as such.
Selecting text's in a specified coordinate-range shouldn't be a problem, see the help on "Select" with filters, construct the filter just as in LISP
(-4 . " (0 . "TEXT")
(-4 . " (-4 . ">") (10 . (100.0 100.0 0.0))
(-4 . "AND>")
(-4 . " (-4 . "<") (10 . (1000.0 1000.0 0.0))
(-4 . "AND>")
(-4 . "AND>")

or

(-4 . " (-4 . "")
(-4 . "")
(-4 . "OR>")

Please check for the right synaxis in the DXF / LISP reference on filters