明总:为什么我这个屏选不到,老出错??

jxb8888

你可否把所有的代码合在一起,不然我看不明白,明总,帮帮忙!

jxb8888

用鼠标点选..的代码是怎样的?真的是难搞!!

jxb8888

这是我的代码:



Private Sub CommandButton1_Click()

' 创建新的选择集
    Dim dimobj As AcadSelectionSet
   

    Set dimobj = ThisDrawing.SelectionSets.Add("ss1")
   
    ' 提示用户选择对象，
    ' 并将其添加到选择集中。
    ' 要完成选择，请按回车键。
    Me.Hide
    dimobj.SelectOnScreen
    '---------------------------

     ' 在模型空间中创建径向标注

If dimobj.Measurement <= 1 Then
dimobj.ToleranceDisplay = acTolDeviation
dimobj.ToleranceLowerLimit = 0.1
dimobj.ToleranceUpperLimit = 0.1
End If

If dimobj.Measurement >= 2 And dimobj.Measurement <= 3 Then
dimobj.ToleranceDisplay = acTolDeviation
dimobj.ToleranceLowerLimit = 0.12
dimobj.ToleranceUpperLimit = 0.12
End If

If dimobj.Measurement >= 3 And dimobj.Measurement <= 4 Then
dimobj.ToleranceDisplay = acTolDeviation
dimobj.ToleranceLowerLimit = 0.16
dimobj.ToleranceUpperLimit = 0.16
End If

If dimobj.Measurement >= 4 And dimobj.Measurement <= 6 Then
dimobj.ToleranceDisplay = acTolDeviation
dimobj.ToleranceLowerLimit = 0.18
dimobj.ToleranceUpperLimit = 0.18
End If

If dimobj.Measurement >= 6 And dimobj.Measurement <= 12 Then
dimobj.ToleranceDisplay = acTolDeviation
dimobj.ToleranceLowerLimit = 0.2
dimobj.ToleranceUpperLimit = 0.2
End If

If dimobj.Measurement >= 12 And dimobj.Measurement <= 19 Then
dimobj.ToleranceDisplay = acTolDeviation
dimobj.ToleranceLowerLimit = 0.23
dimobj.ToleranceUpperLimit = 0.23
End If

If dimobj.Measurement >= 19 And dimobj.Measurement <= 25 Then
dimobj.ToleranceDisplay = acTolDeviation
dimobj.ToleranceLowerLimit = 0.25
dimobj.ToleranceUpperLimit = 0.25
End If

ZoomAll
'----------------
dimobj.Delete
End Sub




鼠标点选的问题已解决!!!!!!谢谢
问题是我怎样把这个选中的对象(标注)重新赋值为一个标注对象,再给它加公差????

leeyeafu

Private Sub CommandButton1_Click()
' 创建新的选择集
  Dim dimobj As AcadSelectionSet
      '以下是我添加的代码
    On Error Resume Next  '遇到错误强行通过，以待后续处理
    Set dimobj = ThisDrawing.SelectionSets.Add("ss1")
      If Err Then    '若遇到错误，就...
        '当然，你也可以看看你遇到的错误码，然后用这样的代码段：
     'If Err.Number = -2145320851
       '或者
    'If Err.Description = '命名选择集已存在'
      Err.Clear     '清除已经出现的错误
    Set dimobj = ThisDrawing.SelectionSets.Item("ss1")  '直接使用已经存在的选择集
    End If
     On Error Goto 0  'Goto后面是数字0，恢复系统错误处理方式
  '以下加上你的其它代码，在这略

'最后，应该加上删除选择集的代码：
dimobj.Delete
End Sub

jxb8888

请问我怎样把:
Dim dimobj As AcadSelectionSet
   

    Set dimobj = ThisDrawing.SelectionSets.Add("ss1")
   
    ' 提示用户选择对象，
    ' 并将其添加到选择集中。
    ' 要完成选择，请按回车键。
    Me.Hide
    dimobj.SelectOnScreen

中选择的对象,,,怎样提取出来为一个AcadDimension对象?????

leeyeafu

Dim Obj As AcadObject
For Each Obj In dimobj
  If Obj.ObjectName Like "AcDb*Dimension" Then
      '这可能是你要问的关键，比较字符串中的*相当于DOS中的通配符
    ToDoYourSomething
  End If
Next Obj

zeng29

Sub DimEdit_Example()
    On Error Resume Next
    ' 创建新的选择集
    Dim sset As AcadSelectionSet
   
    Set sset = ThisDrawing.SelectionSets.Add("SS2")
    If Err Then
        Err.Clear
        Set sset = ThisDrawing.SelectionSets.Item("SS2")
        On Error GoTo 0
    End If
    ' 提示用户选择对象，
    ' 并将其添加到选择集中。
    ' 要完成选择，请按回车键。
    sset.SelectOnScreen
   
    Dim i As Integer
    Dim DimObj As AcadDimension
   
    For i = 0 To sset.Count - 1
        'Example
        If sset.Item(i).ObjectName Like "AcDb*Dimension" Then
            Set DimObj = sset.Item(i)
            DimObj.ToleranceHeightScale = 0.7
            DimObj.ToleranceUpperLimit = 0.25
            DimObj.ToleranceLowerLimit = 0.25
            DimObj.ToleranceDisplay = acTolDeviation
        End If
    Next i
    sset.Delete
End Sub