topic Re: in VBA Forum

Find and Zoom Using Visual Basic

Anonymous — Tue, 24 Sep 2002 05:39:55 GMT

I am trying to get AutoCAD to bring up a drawing or set of drawings and then use the Edit-->Find command to find a certain text string in the drawing and Zoom to it. Then I will be using a third party program to take a snapshot of the screen. This will be done multiple times to find multiple rooms within a drawing or set of drawings. I am looking at automating this using Visual Basic or Visual Basic For Applications.

My question is on the "Find and Replace" dialog box, how can I put information in the textbox for the "Find text string:" prompt and then have the system press some buttons. I want to do this all from VB or VBA without any user intervention. Is this possible at all and if so any ideas/hints on how I can do it?

Re: Find and Zoom Using Visual Basic

Anonymous — Tue, 24 Sep 2002 06:11:10 GMT

Create a SelectionSet

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

"rfrenter" <
href="mailto:rraeth@korbel.net">rraeth@korbel.net> wrote in message
href="news:f11182e.-1@WebX.maYIadrTaRb">news:f11182e.-1@WebX.maYIadrTaRb...
I
am trying to get AutoCAD to bring up a drawing or set of drawings and then use
the Edit-->Find command to find a certain text string in the drawing and
Zoom to it. Then I will be using a third party program to take a snapshot of
the screen. This will be done multiple times to find multiple rooms within a
drawing or set of drawings. I am looking at automating this using Visual Basic
or Visual Basic For Applications.

My question is on the "Find and Replace" dialog box, how can I put
information in the textbox for the "Find text string:" prompt and then have
the system press some buttons. I want to do this all from VB or VBA without
any user intervention. Is this possible at all and if so any ideas/hints on
how I can do it?

Re:

Anonymous — Tue, 24 Sep 2002 06:21:19 GMT

Could you give me any more details?

Re:

Anonymous — Tue, 24 Sep 2002 08:20:22 GMT

I do NOT see how this could work..................!?!?!?

Re: Find and Zoom Using Visual Basic

Anonymous — Tue, 24 Sep 2002 08:22:43 GMT

If the text you're trying to find is in model or paper space and
it is the entire contents of the text entity (as opposed to only
a portion of it) you only need to use a selection set to locate it
(using a filter with the entity type set to "TEXT", and dxf code 1
for the text).

If you're trying to do a case-insensitive search or the text you're
trying to find is only a portion of the entire text entity's contents,
or it is in MTEXT, then it becomes a bit more involved. A selection
set filter with a wildcard can work for regular text, but for MTEXT
there are formatting codes to deal with.

A solution that can deal with any aforementioned case
is the TextProcessor class in AcadX, which you can find at http://www.caddzone.com/acadx

"rfrenter" wrote in message news:f11182e.-1@WebX.maYIadrTaRb...
> I am trying to get AutoCAD to bring up a drawing or set of drawings and then use the Edit-->Find command to find a
certain text string in the drawing and Zoom to it. Then I will be using a third party program to take a snapshot of the
screen. This will be done multiple times to find multiple rooms within a drawing or set of drawings. I am looking at
automating this using Visual Basic or Visual Basic For Applications.
> My question is on the "Find and Replace" dialog box, how can I put information in the textbox for the "Find text
string:" prompt and then have the system press some buttons. I want to do this all from VB or VBA without any user
intervention. Is this possible at all and if so any ideas/hints on how I can do it?
>

Re: Find and Zoom Using Visual Basic

Anonymous — Tue, 24 Sep 2002 08:43:16 GMT

I have a small program to do this, if you'd like I
can e-mail it to you and you can tweak it to suit your needs.

Regards,

Jacob Dinardi

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

"rfrenter" <
href="mailto:rraeth@korbel.net">rraeth@korbel.net> wrote in message
href="news:f11182e.-1@WebX.maYIadrTaRb">news:f11182e.-1@WebX.maYIadrTaRb...
I
am trying to get AutoCAD to bring up a drawing or set of drawings and then use
the Edit-->Find command to find a certain text string in the drawing and
Zoom to it. Then I will be using a third party program to take a snapshot of
the screen. This will be done multiple times to find multiple rooms within a
drawing or set of drawings. I am looking at automating this using Visual Basic
or Visual Basic For Applications.

My question is on the "Find and Replace" dialog box, how can I put
information in the textbox for the "Find text string:" prompt and then have
the system press some buttons. I want to do this all from VB or VBA without
any user intervention. Is this possible at all and if so any ideas/hints on
how I can do it?

Re:

Anonymous — Tue, 24 Sep 2002 09:25:07 GMT

just run the code in vba put text to find in
textbox1

put text to replase in txbox2 an run
it

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

"rfrenter" <
href="mailto:rraeth@korbel.net">rraeth@korbel.net> wrote in message
href="news:f11182e.2@WebX.maYIadrTaRb">news:f11182e.2@WebX.maYIadrTaRb...
I
do NOT see how this could
work..................!?!?!?

Re:

Anonymous — Tue, 24 Sep 2002 09:53:25 GMT

post the code

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

"Jacob Dinardi" <
href="mailto:jacobd@nospam-californianatural.com">jacobd@nospam-californianatural.com>
wrote in message
href="news:F255ADA471150CC8E9F752B43EFEEF78@in.WebX.maYIadrTaRb">news:F255ADA471150CC8E9F752B43EFEEF78@in.WebX.maYIadrTaRb...

I have a small program to do this, if you'd like
I can e-mail it to you and you can tweak it to suit your needs.

Regards,

Jacob Dinardi

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

"rfrenter" <
href="mailto:rraeth@korbel.net">rraeth@korbel.net> wrote in message

href="news:f11182e.-1@WebX.maYIadrTaRb">news:f11182e.-1@WebX.maYIadrTaRb...
I
am trying to get AutoCAD to bring up a drawing or set of drawings and then
use the Edit-->Find command to find a certain text string in the drawing
and Zoom to it. Then I will be using a third party program to take a
snapshot of the screen. This will be done multiple times to find multiple
rooms within a drawing or set of drawings. I am looking at automating this
using Visual Basic or Visual Basic For Applications.

My question is on the "Find and Replace" dialog box, how can I put
information in the textbox for the "Find text string:" prompt and then have
the system press some buttons. I want to do this all from VB or VBA without
any user intervention. Is this possible at all and if so any ideas/hints on
how I can do it?

Re:

Anonymous — Tue, 24 Sep 2002 10:02:39 GMT

That would be great Jacob. Thanks..................

Re:

Anonymous — Tue, 24 Sep 2002 11:46:02 GMT

okay post the code

LHGO

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

"rfrenter" <
href="mailto:rraeth@korbel.net">rraeth@korbel.net> wrote in message
href="news:f11182e.7@WebX.maYIadrTaRb">news:f11182e.7@WebX.maYIadrTaRb...
That
would be great Jacob. Thanks..................

Re:

Anonymous — Tue, 24 Sep 2002 12:21:28 GMT

There is not a whole lot to it, so I figured I'd
just post the code. You should be able to paste all this into a module and run
it, the program does expect there to be a layer named "B" - you should be able
to find and edit it. Fair warning this was an early attempt at acad vba, so it
could use some optimizing I'm sure. With that said, here ya go, and watch out
for word wrap...

Option Explicit

Dim oSS As AcadSelectionSet
Dim oEnt As
AcadEntity
Dim RemObj() As AcadEntity
Dim oLayer As AcadLayer
Dim
bLayers() As Boolean
Dim sFind As String
Dim i As Integer, j As
Integer
Dim fType(0) As Integer, fData(0) As Variant, Pt() As
Variant

Public Sub Run_FindBOM()
On Error Resume
Next

'Isolate layer B
IsolateLayers

ActiveDocument.Layers("B").LayerOn = True

'Create the
selection set
MakeSelSet

'Get the letter to
find
sFind = ActiveDocument.Utility.GetString(False, "Enter the mark
to find: ")
'Remove all non-matches
i = oSS.Count

j = 0
For i = 0 To oSS.Count - 1
    If
oSS.Item(i).TextString <> sFind Then

ReDim Preserve RemObj(j)
      Set RemObj(j) =
oSS.Item(i)
      j = j + 1

End If
Next
'Get rid of all the items that don't
match
oSS.RemoveItems RemObj

'Report matches
found and zoom to each
If oSS.Count Then
    If
MsgBox(oSS.Count & " matches found. Do you want to see them?", vbYesNo) =
vbYes Then
      'Restore the previous layer
states
      For i = 0 To
ActiveDocument.Layers.Count - 1

ActiveDocument.Layers(i).LayerOn = bLayers(i)

Next


'Create the array of text insertion points

ReDim Pt(oSS.Count)
      j =
0
      For Each oEnt In
oSS
        Pt(j) =
oEnt.InsertionPoint
        j = j +
1
      Next


      Application.ZoomCenter Pt(LBound(Pt)), (5 *
ActiveDocument.GetVariable("DIMSCALE"))


      For i = LBound(Pt) + 1 To UBound(Pt) -
1
        If
UCase(ActiveDocument.Utility.GetString(False, "View next (Y/N)? ")) <> "Y"
Then Exit For

Application.ZoomCenter Pt(i), (5 *
ActiveDocument.GetVariable("DIMSCALE"))

Next
    End If
Else
    'No
matches were found
    MsgBox "No balloons matching """ &
sFind & """ were located."
End If


CleanUp
Exit Sub

ERRTRAP:

ActiveDocument.SelectionSets("SSFIND").Delete
    For i = 0 To
ActiveDocument.Layers.Count - 1

ActiveDocument.Layers(i).LayerOn = bLayers(i)

Next
    CleanUp

End
Sub

Private Sub IsolateLayers()
'Store the
current layer state of each layer in the drawing
For i = 0 To
ActiveDocument.Layers.Count - 1
    ReDim Preserve
bLayers(i)
    bLayers(i) =
ActiveDocument.Layers(i).LayerOn

ActiveDocument.Layers(i).LayerOn = False
Next
End Sub

Private Sub MakeSelSet()
On Error Resume
Next
ActiveDocument.SelectionSets("SSFIND").Delete

ActiveDocument.Utility.Prompt "Select all balloons: "
Set oSS =
ActiveDocument.SelectionSets.Add("SSFIND")
fType(0) = 0: fData(0) =
"TEXT"
oSS.SelectOnScreen fType, fData
End Sub

Sub CleanUp()
Set oSS = Nothing

Set oEnt = Nothing
Set oLayer = Nothing
Erase
bLayers
Erase fType
Erase fData
Erase fType
End
Sub

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

"rfrenter" <
href="mailto:rraeth@korbel.net">rraeth@korbel.net> wrote in message
href="news:f11182e.7@WebX.maYIadrTaRb">news:f11182e.7@WebX.maYIadrTaRb...
That
would be great Jacob. Thanks..................

Re:

Anonymous — Tue, 24 Sep 2002 23:08:19 GMT

Private Sub MakeSelSet()
Dim oText
As AcadText

    Dim vvar1 As
Variant
    ActiveDocument.Utility.GetEntity oText, vvar1,
"Select a 'TEXT': "
    oText.TextString =
"test1"

End Sub

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

"Jacob Dinardi" <
href="mailto:jacobd@nospam-californianatural.com">jacobd@nospam-californianatural.com>
wrote in message
href="news:C42AE01BCC30C32AE79C7CBE0A7A738A@in.WebX.maYIadrTaRb">news:C42AE01BCC30C32AE79C7CBE0A7A738A@in.WebX.maYIadrTaRb...

There is not a whole lot to it, so I figured I'd
just post the code. You should be able to paste all this into a module and run
it, the program does expect there to be a layer named "B" - you should be able
to find and edit it. Fair warning this was an early attempt at acad vba, so it
could use some optimizing I'm sure. With that said, here ya go, and watch out
for word wrap...

Option Explicit

Dim oSS As AcadSelectionSet
Dim oEnt As
AcadEntity
Dim RemObj() As AcadEntity
Dim oLayer As AcadLayer
Dim
bLayers() As Boolean
Dim sFind As String
Dim i As Integer, j As
Integer
Dim fType(0) As Integer, fData(0) As Variant, Pt() As
Variant

Public Sub Run_FindBOM()
On Error
Resume Next

'Isolate layer B

IsolateLayers
ActiveDocument.Layers("B").LayerOn = True

'Create the selection set
MakeSelSet

'Get the letter to find
sFind =
ActiveDocument.Utility.GetString(False, "Enter the mark to find: ")

'Remove all non-matches
i = oSS.Count
j = 0
For
i = 0 To oSS.Count - 1
    If oSS.Item(i).TextString
<> sFind Then
      ReDim Preserve
RemObj(j)
      Set RemObj(j) =
oSS.Item(i)
      j = j + 1

End If
Next
'Get rid of all the items that don't
match
oSS.RemoveItems RemObj

'Report matches
found and zoom to each
If oSS.Count Then
    If
MsgBox(oSS.Count & " matches found. Do you want to see them?", vbYesNo) =
vbYes Then
      'Restore the previous layer
states
      For i = 0 To
ActiveDocument.Layers.Count - 1

ActiveDocument.Layers(i).LayerOn =
bLayers(i)

Next


'Create the array of text insertion points

ReDim Pt(oSS.Count)
      j =
0
      For Each oEnt In
oSS
        Pt(j) =
oEnt.InsertionPoint
        j = j +
1
      Next


      Application.ZoomCenter Pt(LBound(Pt)), (5 *
ActiveDocument.GetVariable("DIMSCALE"))


      For i = LBound(Pt) + 1 To UBound(Pt) -
1
        If
UCase(ActiveDocument.Utility.GetString(False, "View next (Y/N)? ")) <>
"Y" Then Exit For

Application.ZoomCenter Pt(i), (5 *
ActiveDocument.GetVariable("DIMSCALE"))

Next
    End If
Else
    'No
matches were found
    MsgBox "No balloons matching """
& sFind & """ were located."
End If


CleanUp
Exit Sub

ERRTRAP:

ActiveDocument.SelectionSets("SSFIND").Delete
    For i = 0
To ActiveDocument.Layers.Count - 1

ActiveDocument.Layers(i).LayerOn = bLayers(i)

Next
    CleanUp

End
Sub

Private Sub IsolateLayers()
'Store the
current layer state of each layer in the drawing
For i = 0 To
ActiveDocument.Layers.Count - 1
    ReDim Preserve
bLayers(i)
    bLayers(i) =
ActiveDocument.Layers(i).LayerOn

ActiveDocument.Layers(i).LayerOn = False
Next
End
Sub

Private Sub MakeSelSet()
On Error
Resume Next
ActiveDocument.SelectionSets("SSFIND").Delete

ActiveDocument.Utility.Prompt "Select all balloons: "
Set oSS =
ActiveDocument.SelectionSets.Add("SSFIND")
fType(0) = 0: fData(0) =
"TEXT"
oSS.SelectOnScreen fType, fData
End Sub

Sub CleanUp()
Set oSS =
Nothing
Set oEnt = Nothing
Set oLayer = Nothing

Erase bLayers
Erase fType
Erase fData
Erase
fType
End Sub

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

"rfrenter" <
href="mailto:rraeth@korbel.net">rraeth@korbel.net> wrote in message

href="news:f11182e.7@WebX.maYIadrTaRb">news:f11182e.7@WebX.maYIadrTaRb...
That
would be great Jacob.
Thanks..................