match proporties of dim text overide value

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,

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

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

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

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