dim text o的匹配比例

comcu · 发表于 2022-7-6 17:24:56

你好

我希望有人能帮助我。

我有下面的代码

基本上，它存储dim text overide值，并填充下一个选定dim的值。

然而，我希望能把它浓缩一点。而不是选择暗显，输入，选择下一个暗显，输入我希望选择暗显，选择下一个暗显，然后输入？

所以我必须改变选择集，只允许一个选择，然后进入下一位代码，这可能吗？？

copy


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

谢谢你的帮助。

PS msgbox只是我在测试，

ML0940 · 发表于 2022-7-6 17:48:25

Comcu公司

听起来你可能需要一个边做边做的循环

条件为真时执行

有了它，你就可以一直挑选，直到用户点击escape或enter

毫升

comcu · 发表于 2022-7-6 18:01:11

毫升，

谢谢你的帮助。

该代码允许我一直拾取，直到按enter键。我更希望用户能够只选择一个维度，然后代码模拟用户点击enter？

干杯

Col公司

ML0940 · 发表于 2022-7-6 18:16:06

嗨，Col

不用尝试你的代码，我可以看到你正在使用selectonscreen，这很好。

我仍然倾向于做一个while循环

我们需要做一个选择=True

我不是做While循环的高手，似乎每次我尝试一个循环，我都需要寻求帮助。

如果你愿意的话，我们可以仔细看看？

你有可以发送的dwg文件吗？

毫升

SEANT · 发表于 2022-7-6 18:38:55

选择集的另一种选择是ThisDrawing，特别是当首选单拾取时。公用事业GetEntity方法。例如，下面修改了线程初始帖子中的代码。与示例一样，错误检查非常有限。

注意：可以删除子“MatchDimTextOverideValueP2”中的循环操作，以仅允许在该点进行单次拾取。

copy

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

[编程交流] dim text o的匹配比例

发表回复

精选推荐