Eng-Tips is the largest engineering community on the Internet

Intelligent Work Forums for Engineering Professionals

  • Congratulations waross on being selected by the Eng-Tips community for having the most helpful posts in the forums last week. Way to Go!

2D Drawings Checking Macro Catia

Status
Not open for further replies.

Cristian NR

Automotive
Jul 3, 2017
2
DE
Hi everybody.
Nice Forum here, i am glad to join you!
I have to check a tone of Fixtures Drawings and it will take me like forever without a CATIA MACRO.
I need a macro to direct me to the 2D drawings problems if possible without opening the folder.
I have found something but doesn't work properly.
It runs and ends without finding the problems.
Please help me with a working Macro and ideas that you have on checking a drawing faster.



Here is the code that i have :
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: V5R19
' Locales: English
' CATIA Level: V5R19
'
' ****************************************************************************

'---------------------------------------------------------------------------

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

'This part it woes crashing on this error line" Err.Raise 9999,,"No Doc Path Defined" and i have deactivated

' 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

' Open the Drawing document
' Dim oDoc As Document
' set oDoc = CATIA.Documents.Open(sDocPath & _
' "\online\CAAScdDriUseCases\samples\CAADriDimension.CATDrawing")

'---------------------------------------------------------------------------
'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 HeadTaget 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


Thank you in advance for every word that you write!
Regards Cristian NR
 
Replies continue below

Recommended for you

How can you check a drawing is correct without opening it.
Dimensions could be missing, holes with incorrect tolerances and any number of other mistakes could be on there.
How can a macro decide what a surface tolerance should be or from where GD&T datums are taken?
I have seen some macros that change line types, text heights and a few other things but I wouldn't let a drawing through that I hadn't checked and passed off.

just my 2 pence worth :)

 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top