Makro AI2008 - přepsaná kóta

Tímto makrem do Autodesk Inventor 2008 se ve výkrese kóty, které mají přepsanou hotnotu kóty modelu, zvýrazní červeně a při dalším zpuštění zase zčernají.

Public Sub ZvyrazniPrepsane()
 If Not ThisApplication.ActiveDocument.DocumentType = kDrawingDocumentObject Then
  MsgBox "Funkci lze použít jen ve výkrese."
  Exit Sub
 End If
 Dim oDrgDoc As DrawingDocument
 Set oDrgDoc = ThisApplication.ActiveDocument
 Dim AList As Sheet
 Set AList = oDrgDoc.ActiveSheet
 Dim counter As Long
 Dim VybranaKota As DrawingDimension
 Dim BarvaCervena As Inventor.Color
 Set BarvaCervena = ThisApplication.TransientObjects.CreateColor(255, 0, 0)
 Dim BarvaCerna As Inventor.Color
 Set BarvaCerna = ThisApplication.TransientObjects.CreateColor(0, 0, 0)
 Dim Obarvit As String
 Obarvit = "zjistit"
 For Each VybranaKota In AList.DrawingDimensions  
  If VybranaKota.ModelValueOverridden Then
   If Obarvit = "zjistit" Then
    If VybranaKota.Text.Color.Red = 255 Then
     Obarvit = "black"
    Else
     Obarvit = "red"
    End If
   End If
   If Obarvit = "red" Then
    VybranaKota.Text.Color = BarvaCervena
   ElseIf Obarvit = "black" Then
    VybranaKota.Text.Color = BarvaCerna
   End If
  End If
 Next
End Sub