dim text o的匹配比例
你好我希望有人能帮助我。
我有下面的代码
基本上，它存储dim text overide值，并填充下一个选定dim的值。
然而，我希望能把它浓缩一点。而不是选择暗显，输入，选择下一个暗显，输入我希望选择暗显，选择下一个暗显，然后输入？
所以我必须改变选择集，只允许一个选择，然后进入下一位代码，这可能吗？？
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只是我在测试， Comcu公司
听起来你可能需要一个边做边做的循环
条件为真时执行
有了它，你就可以一直挑选，直到用户点击escape或enter
毫升 毫升，
谢谢你的帮助。
该代码允许我一直拾取，直到按enter键。我更希望用户能够只选择一个维度，然后代码模拟用户点击enter？
干杯
Col公司 嗨，Col
不用尝试你的代码，我可以看到你正在使用selectonscreen，这很好。
我仍然倾向于做一个while循环
我们需要做一个选择=True
我不是做While循环的高手，似乎每次我尝试一个循环，我都需要寻求帮助。
如果你愿意的话，我们可以仔细看看？
你有可以发送的dwg文件吗？
毫升 选择集的另一种选择是ThisDrawing，特别是当首选单拾取时。公用事业GetEntity方法。例如，下面修改了线程初始帖子中的代码。与示例一样，错误检查非常有限。
注意：可以删除子“MatchDimTextOverideValueP2”中的循环操作，以仅允许在该点进行单次拾取。
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
页:
[1]