Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 283
  • Last Modified:

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,
0
Oscar9er
Asked:
Oscar9er
  • 2
1 Solution
 
Oscar9erAuthor Commented:
would accept a 3rd party tool recommendation as an answer as well
0
 
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

0
 
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

0

Featured Post

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now