Dim Language as String
Language="VBScript"
'---------------------------------------------------------------------------
'COPYRIGHT DASSAULT SYSTEMES 2002
' ****************************************************************************
'
' Purpose: To analyze a subset of dimensions pointed by text leaders
' in the active drafting document.
' That macro checks all dimensions pointed by text leader elements.
' If dimensions have a wrong display (tolerances or wrong frame)
' text leader object is highlighted.
'
' Assumptions: A Drafting document should be active
'
' Author:
' Languages: VBScript
' Version: V5R10
' Locales: English
' CATIA Level: V5R10
'
' ****************************************************************************
'---------------------------------------------------------------------------
Sub CATMain()
' Set the CATIA popup file alerts to False
' It prevents to stop the macro at each alert during its execution
CATIA.DisplayFileAlerts = False
' Optional: allows to find the sample wherever it's installed
dim sDocPath As String
sDocPath=CATIA.SystemService.Environ("CATDocView")
If (Not CATIA.FileSystem.FolderExists(sDocPath)) Then
Err.Raise 9999,,"No Doc Path Defined"
End If
'---------------------------------------------------------------------------
'1/ Read active CATDrawing Document
'---------------------------------------------------------------------------
Dim DrwDoc As DrawingDocument
Set DrwDoc = CATIA.ActiveDocument
' Get Selection Object and clear it
Dim DrwSelect As Selection
Set DrwSelect = DrwDoc.Selection
' Variables declaration
Dim ElemDispatch As CATBaseDispatch
Dim NomObj As String
Dim numsheet As Long
Dim numview As Long
Dim numtxt As Long
Dim numleader As Long
'---------------------------------------------------------------------------
'2/ Scan all the sheet of the current drawing (Included detail sheet)
'---------------------------------------------------------------------------
Dim DrwSheets As DrawingSheets
Set DrwSheets = DrwDoc.Sheets
Dim CurrentSheet As DrawingSheet
'Read the current sheet to restore it at the end of the macro
Dim SheetToRestore As DrawingSheet
Set SheetToRestore = DrwSheets.ActiveSheet
For numsheet = 1 To DrwSheets.Count
Set CurrentSheet = DrwSheets.Item(numsheet)
' Active Currentsheet
CurrentSheet.Activate
' Clear the selection
DrwSelect.Clear
Dim DrwViews As DrawingViews
Set DrwViews = CurrentSheet.Views
'Read the current view to restore it at the end of the macro
Dim ViewToRestore As DrawingView
Set ViewToRestore = DrwViews.ActiveView
'---------------------------------------------------------------------------
'3/ Scan all the view of the current sheet
'---------------------------------------------------------------------------
Dim CurrentView As DrawingView
For numview = 1 To DrwViews.Count
Set CurrentView = DrwViews.Item(numview)
'Active the current view
CurrentView.Activate
'---------------------------------------------------------------------------
'4/ Scan all the texts of the current view
'---------------------------------------------------------------------------
Dim Texts As DrawingTexts
Set Texts = CurrentView.Texts
For numtxt = 1 To Texts.Count
Dim CurrentText As DrawingText
Set CurrentText = Texts.Item(numtxt)
'---------------------------------------------------------------------------
'5/ Scan all the leaders of the current text
'---------------------------------------------------------------------------
Dim Leaders As DrawingLeaders
Set Leaders = CurrentText.Leaders
For numleader = 1 To Leaders.Count
Dim CurrentLeader As DrawingLeader
Set CurrentLeader = Leaders.Item(numleader)
' Manage error on HeadTarget method when
' no element is pointed by the text leader.
On Error Resume Next
' Get object pointed on the leader
Set ElemDispatch = Nothing
Set ElemDispatch = CurrentLeader.HeadTarget
NomObj = TypeName(ElemDispatch)
'------------------------------------------------------------------------------
'6/ Check tolerances and the frame type of the dimension pointed by text leader
'------------------------------------------------------------------------------
' A dimension is pointed by text leader
If NomObj = "DrawingDimension" Then
' Get the dimension object
Dim PointedDim As DrawingDimension
Set PointedDim = ElemDispatch
' Read dimension tolerances
Dim oTolType As Long
Dim oDisplayMode As Long
Dim oTolName As String
Dim oUpTolS As String
Dim oLowTolS As String
Dim oUpTolD As Double
Dim oLowTolD As Double
PointedDim.GetTolerances oTolType, oTolName, oUpTolS, oLowTolS, oUpTolD, oLowTolD, oDisplayMode
' Read dimension frame type
Dim TypeFrame As CatDimFrame
TypeFrame = PointedDim.ValueFrame
'---------------------------------------------------------------------------
'7/ Change the visualization of the text leader linked to that dimension
'---------------------------------------------------------------------------
' If dimension does not respect the criteria text leader object is highlighted
If oTolType <> 0 Or TypeFrame <> catFraRectangle Then
DrwSelect.Add CurrentText
DrwSelect.VisProperties.SetRealColor 255, 0, 0, 0
DrwSelect.VisProperties.SetRealWidth 6, 1
End If
End If
Next
Next
'Restore the view
ViewToRestore.Activate
Next
Next
'Restore the Drawing Document sheet
SheetToRestore.Activate
End Sub