Guten Morgen zusammen,
ich habe im Forum folgendes Makro gefunden um überschriebene Maße auf einer idw zu finden und zu makieren. Ich würde mir aber wünschen das nur der überschriebene Maßtext / Maßwert unterstrichen dargestellt wird. Wer kann mir mit dieser Makroanpassung helfen? Ich danke schon mal im voraus für alle Hilfestellung.
Public Sub check_dims()
Dim i As Integer
Dim wrong As Integer
Dim dimv As Inventor.DrawingDimension
Dim oDoc As Inventor.DrawingDocument
Set oDoc = ThisApplication.ActiveDocument
If oDoc.DocumentType <> kDrawingDocumentObject Then Exit Sub
If oDoc.ActiveSheet.DrawingViews.Count = 0 Then Exit Sub
wrong = 0
i = 1
For Each dimv In oDoc.ActiveSheet.DrawingDimensions
'check for manipulatet diminsions
If oDoc.ActiveSheet.DrawingDimensions.Item(i).ModelValueOverridden = True Then
wrong = wrong + 1
oDoc.ActiveSheet.DrawingDimensions.Item(i).Text.FormattedText = "<DimensionValue/> <StyleOverride Bold='True' Underline='True'>(Maß wurde überschrieben!)</StyleOverride>"
End If
'check for invisible dimensions
'If oDoc.ActiveSheet.DrawingDimensions.Item(i).HideValue = True Then
'wrong = wrong + 1
'oDoc.ActiveSheet.DrawingDimensions.Item(i).Text.FormattedText = "<DimensionValue/> <StyleOverride Bold='True' Underline='True'>(Maß wurde ausgeblendet!)</StyleOverride>"
'End If
i = i + 1
Next
If wrong > 0 Then
MsgBox "Manipullierte Bemaßung !!! BITTE PRÜFEN !!!", vbCritical
End If
'If wrong < 1 Then
'MsgBox "Es wurde(n) keine manipullierte(n) Bemaßung(en) gefunden", vbCritical
'End If
End Sub
------------------
MFG
BlueJay
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP