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:
Post a Comment