Add diameter symbols to dimensions

Few years ago I wrote a macro for add diameter symbol to dimensions. I have button with macro for write or erase diameter. Only select dimensuion and push macro button. Here is the code.

Public Sub PrumerPredKotu()

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

If oDrgDoc.SelectSet.Count < 1 Then
 MsgBox "Musí být vybána kóta"
 Exit Sub
End If

Dim i As Long
Dim counter As Long
counter = 1
Dim VybranaKota As DrawingDimension

For Each VybranaKota In oDrgDoc.SelectSet

If VybranaKota.Tolerance.ToleranceType = kReferenceTolerance Then
 VybranaKota.Tolerance.SetToDefault
 VybranaKota.Text.FormattedText = "(" & ChrW(216) & VybranaKota.Text.FormattedText & ")"

Else

If Left(VybranaKota.Text.Text, 1) = ChrW(216) Then

VybranaKota.Text.FormattedText = Mid(VybranaKota.Text.FormattedText, 2, Len(VybranaKota.Text.FormattedText) - 1)

ElseIf Left(VybranaKota.Text.Text, 1) = "(" And Mid(VybranaKota.Text.Text, 2, 1) = ChrW(216)   Then

VybranaKota.Text.FormattedText = "(" & Mid(VybranaKota.Text.FormattedText, 3, Len(VybranaKota.Text.FormattedText) - 3) & ")"

ElseIf Left(VybranaKota.Text.Text, 1) = "(" Then

VybranaKota.Text.FormattedText = "(" & ChrW(216) & Mid(VybranaKota.Text.FormattedText, 2, Len(VybranaKota.Text.FormattedText) - 2) & ")"

Else

VybranaKota.Text.FormattedText = ChrW(216) & VybranaKota.Text.FormattedText

End If

End If
counter = counter + 1

Next

End Sub

No comments: