社区 › VB › 固定标注值并改变标注颜色出现的新问题

lennie 发表于 2006-4-19 16:44:00

固定标注值并改变标注颜色出现的新问题

Private Sub CommandButton1_Click()
On Error GoTo Err_handle
    Dim FilterType(0) As Integer
    Dim FilterData(0) As Variant
    Dim point As Variant
    Me.Hide
   
    Set SSdim = ThisDrawing.SelectionSets.Add("S_t_dim")
      FilterType(0) = 0
      FilterData(0) = "DIMENSION"
      SSdim.SelectOnScreen FilterType, FilterData
    If SSdim.Count = 0 Then
      MsgBox "你没有选择标注，程序中止！", vbOKOnly
      ThisDrawing.SelectionSets.Item("S_t_dim").Delete
      End
    End If
    Dim EntityInBlock As AcadEntity
    Dim TextString As String
    Dim Sobj As AcadObject
    Dim BlkId As Double
   
    For Each Sobj In SSdim
      BlkId = Sobj.OwnerID
      TextString = "123"
      For Each EntityInBlock In ThisDrawing.ObjectIdToObject(BlkId)
            If EntityInBlock.ObjectName = "AcDbMText" Then
                TextString = EntityInBlock.TextString
                Exit For
            End If
      Next
      Sobj.TextOverride = TextString
      Sobj.TextColor = acYellow
    Next
   
      ThisDrawing.SelectionSets.Item("S_t_dim").Delete
   
    Exit Sub
Err_handle:
    If Err.Number = -2145320851 Then   '已经存在“S_t_dim”选集
      ThisDrawing.SelectionSets.Item("S_t_dim").Delete
      CommandButton1_Click
    End If
End Sub

查看完整版本: 固定标注值并改变标注颜色出现的新问题