Run a command that would open each group of text zoom to it, open it in a dialog box choose to delete or keep

Hello,

I am looking for help or guidance on doing the following, I would prefer to do it in vba since I am more familiar with this but would take any and all suggestions....

I have a couple of hundred of maps to clean....

I would like to run a command that would open each group of text (mtext) in a drawing, zoom to it,  open it in a a dialog box and then let the user click delete or keep. After they select one or the other it would automatically go to the next group of text by layer.

I already have a command to convert all the text to mtext.

thanks in advance for the help,
Oscar9erAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Oscar9erAuthor Commented:
would accept a 3rd party tool recommendation as an answer as well
Tommy KinardCommented:
Hi Oscar9er,

In the below code I have a form with 3 command buttons 1 textbox. The command is GetMtext, it will select all mtext on the drawing, cycle through the selection set filling the textbox with the text string and zoom to the string. The user will then be presented with a choice of deleting, or next (the user can edit the text), or done (through with edits). When there are no more items it complains with a message box and stops.

The form code:
'-----------------------------------------------------------------
Private mCntr As Long

Private Sub CommandButton1_Click() 'delete
    Dim mMin As Variant, mMax As Variant
    ssetA(mCntr - 1).Delete
    ThisDrawing.Regen acActiveViewport
    TextBox1.Text = ssetA(mCntr).TextString
    ssetA(mCntr).GetBoundingBox mMin, mMax
    ZoomWindow mMin, mMax
    ThisDrawing.Regen acActiveViewport
    mCntr = mCntr + 1
End Sub

Private Sub CommandButton2_Click() 'next
    Dim mMin As Variant, mMax As Variant
    If mCntr < ssetA.Count Then
        ssetA(mCntr - 1).TextString = TextBox1.Text
        TextBox1.Text = ssetA(mCntr).TextString
        ssetA(mCntr).GetBoundingBox mMin, mMax
        ZoomWindow mMin, mMax
        ThisDrawing.Regen acActiveViewport
        mCntr = mCntr + 1
    Else
        ssetA(mCntr - 1).TextString = TextBox1.Text
        MsgBox "All Items have been edited."
        Unload Me
    End If
End Sub

Private Sub CommandButton3_Click() 'done
    Unload Me
End Sub

Private Sub UserForm_Activate()
    Dim mMin As Variant, mMax As Variant
    TextBox1.Text = ssetA(mCntr).TextString
    ssetA(mCntr).GetBoundingBox mMin, mMax
    ZoomWindow mMin, mMax
    ThisDrawing.Regen acActiveViewport
    mCntr = mCntr + 1
End Sub
'-----------------------------------------------------------------
The Module code :
'-----------------------------------------------------------------
Public ssetA As AcadSelectionSet
Function Aset(iSSetName As String) As AcadSelectionSet
    Dim sRetA As AcadSelectionSet
    On Error Resume Next
    Set sRetA = ThisDrawing.SelectionSets.Add(iSSetName)
    If Err.Number <> 0 Then
        Set sRetA = ThisDrawing.SelectionSets(iSSetName)
        sRetA.Delete
        Set sRetA = ThisDrawing.SelectionSets.Add(iSSetName)
        Err.Clear
    End If
    On Error GoTo 0
    Set Aset = sRetA
    Set sRetA = Nothing
End Function
Public Sub GetMtext()
    Dim groupCode As Variant, dataCode As Variant
    Dim mPta As Variant, mPtb As Variant
    Dim gpCode(0) As Integer
    Dim dataValue(0) As Variant
    gpCode(0) = 0
    dataValue(0) = "MTEXT"
    groupCode = gpCode
    dataCode = dataValue
    mPta = ThisDrawing.GetVariable("EXTMAX")
    mPtb = ThisDrawing.GetVariable("EXTMIN")
    Set ssetA = Aset("FIXMTEXT")
    ssetA.Select acSelectionSetAll, mPta, mPtb, groupCode, dataCode
    frmMtext.Show
    ssetA.Clear
    ssetA.Delete
    Set ssetA = Nothing
End Sub

'----------------------------------------------------
end code

HTH
dragontooth

Tommy KinardCommented:
<sigh>
I didn't test as well as I should have
</sigh>

With this new and improved code it will complain when deleteing the last item and then exit instead of crying about an error. :)

Private Sub CommandButton1_Click() 'delete
    Dim mMin As Variant, mMax As Variant
    ssetA(mCntr - 1).Delete
    ThisDrawing.Regen acActiveViewport
    If mCntr < ssetA.Count Then
        TextBox1.Text = ssetA(mCntr).TextString
        ssetA(mCntr).GetBoundingBox mMin, mMax
        ZoomWindow mMin, mMax
        ThisDrawing.Regen acActiveViewport
        mCntr = mCntr + 1
    Else
        MsgBox "All Items have been edited."
        Unload Me
    End If
End Sub

dragontooth

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
CAD/Architecture Software

From novice to tech pro — start learning today.