match proporties of dim text overide value

[comcu]

Hi,

I hope someone can help me.

I have the code below that works

basicaly it stores the dim text overide value and the fills the value of the next dim selected.

However i was hoping to condense it a bit. Instead of select dim, enter, select next dim, enter i was hoping for select dim, selct next dim and then enter?

so i would have to change the selection set to allow only one selection and then onto the next bit of code, is this possible??

Public MyDmTxtOvrdeStr As String

Sub MatchDimTextOverideValueP1()

'allows selecting dim on screen
'stores the dim text overide value

'Dim MyDmTxtOvrdeStr As String
Dim MyDim As AcadDimension
Dim MyoEnt As AcadEntity
Dim MyObjSS As AcadSelectionSet

    On Error Resume Next
    ThisDrawing.SelectionSets("SelectDim").Delete
    If Err Then Err.Clear
    With ThisDrawing.Utility
    
        '' create a new selectionset
        Set MyObjSS = ThisDrawing.SelectionSets.Add("SelectDim")

        '' let user select entities interactively
        MyObjSS.SelectOnScreen
        
        MyObjSS.Highlight True
        
        '' pause for the user
        .prompt vbCr & MyObjSS.Count & " entities selected"
        '.GetString False, vbLf & "Enter to continue "

        'For Each MyoEnt In MyObjSS
        For Each MyoEnt In MyObjSS
        
           ' If TypeOf MyoEnt Is AcadDimension Then
           If TypeOf MyoEnt Is AcadDimension Then
    
                Set MyDim = MyoEnt
                      MyDmTxtOvrdeStr = MyDim.TextOverride
                        MsgBox MyDmTxtOvrdeStr
                        'MyAttTextStr = myvaratt(i).TextString
                        
                        MyObjSS.Highlight False

                    End If
                Next
           ' End If
       ' Next
End With



MatchDimTextOverideValueP2
   End Sub


Private Sub MatchDimTextOverideValueP2()
'allows selecting dim on screen
'pastes the dim text overide value into the newly selected dim

'Dim MyDmTxtOvrdeStr As String
Dim MyDim As AcadDimension
Dim MyoEnt As AcadEntity
Dim MyObjSS As AcadSelectionSet

    On Error Resume Next
    ThisDrawing.SelectionSets("SelectDim").Delete
    If Err Then Err.Clear
    With ThisDrawing.Utility
    
        '' create a new selectionset
        Set MyObjSS = ThisDrawing.SelectionSets.Add("SelectDim")

        '' let user select entities interactively
        MyObjSS.SelectOnScreen
        
        MyObjSS.Highlight True
        
        '' pause for the user
        .prompt vbCr & MyObjSS.Count & " entities selected"
        '.GetString False, vbLf & "Enter to continue "

        'For Each MyoEnt In MyObjSS
        For Each MyoEnt In MyObjSS
        
           ' If TypeOf MyoEnt Is AcadDimension Then
           If TypeOf MyoEnt Is AcadDimension Then
    
                Set MyDim = MyoEnt
                
                      'MyDmTxtOvrdeStr = MyDim.TextOverride
                      
                    MyDim.TextOverride = MyDmTxtOvrdeStr
                        
                        'MsgBox MyDmTxtOvrdeStr


                    End If
                Next
           ' End If
       ' Next
End With

End Sub

thank you for any help.

PS the msgbox was just me testing,

[ML0940]

Comcu

It sounds like you may need a do while loop

Do while condition is True

With that you will be able to keep picking until the user hits escape or enter

ML

[comcu]

ML,

thank you for your help.

the code allows me to keep picking until i hit enter. its more that i want the user to be able to select only 1 dimension and then the code simulates the user hitting enter?

Cheers,

Col

[ML0940]

Hi Col

Without trying your code, I can see that you are using a selectonscreen, that is good.

I'm still leaning to wards a do while loop

We would need to do a picked = True

I am not the greatest with Do While Loops, it seems like every time I attempt one, I need to reach out for help.

We could take a closer look, if you'd like?

Do you have a dwg file you could send?

ML

[SEANT]

An alternative to Selection Sets – specifically when single picks are preferred – is the ThisDrawing.Utility.GetEntity method. As an example, the code in the threads initial post was modified below. As usual with examples, there is limited error checking.

Note: The looping action in Sub “MatchDimTextOverideValueP2” can be removed to only allow single picks at that point as well.

Public MyDmTxtOvrdeStr As String

Sub MatchDimTextOverideValueP1()

Dim MyDim As AcadDimension
Dim MyoEnt As AcadEntity

Dim varPkPt As Variant

    With ThisDrawing.Utility
      On Error GoTo Escapement
      .GetEntity MyoEnt, varPkPt, "Select Overridden Dimension: "
      
      If TypeOf MyoEnt Is AcadDimension Then
         Set MyDim = MyoEnt
         MyDmTxtOvrdeStr = MyDim.TextOverride
         MyoEnt.Highlight True
         MsgBox MyDmTxtOvrdeStr
         MyoEnt.Highlight True
      End If
   End With
   
   MatchDimTextOverideValueP2
   
   MyoEnt.Highlight False
Escapement:
End Sub


Private Sub MatchDimTextOverideValueP2()
Dim MyDim As AcadDimension
Dim MyoEnt As AcadEntity

Dim varPkPt As Variant

    With ThisDrawing.Utility
    On Error GoTo Escapement
    Do
      .GetEntity MyoEnt, varPkPt, "Select Dimension(s) to override: "
      If TypeOf MyoEnt Is AcadDimension Then
         Set MyDim = MyoEnt
         MyDim.TextOverride = MyDmTxtOvrdeStr
         MyoEnt.Highlight False
      End If
   Loop
   End With
Escapement:
End Sub