Please feel free to enter any handy code snippets here for the use of the public.



ALSO, PLEASE CHANGE/EDIT YOUR MESSAGE TITLE TO REFLECT WHAT YOUR CODE DOES. This way users can click on the link to get to it quickly since we are starting to get a number of them.



Thanks in advance,
-craig


Currently listed are:

1) Message Boxes
2) Reading from / Accessing Excel
3) Write to a Text File
4) Hide / Show things
5) Change Color of Dimensions in a Drawing
6) Change Line Type in Drawing
7) Insert Existing Component at a Ponit
8) Move active excel sheet
9) Identify Components in a Product
10) A batch convert - CATPart to STP (Windows)
11) A batch convert - CATPart to STP (Unix)
12) Modify View Scale

Message Boxes -

Language = "VBSCRIPT"

Sub CATMain()

' ====> Get INPUT FROM USER

Flag = 1
While (Flag = 1)
Inp1 = InputBox("VAR_Name","DialogHeader", "10")
' ===> Input validity condition.
if (Inp1 < 10) Then Flag = 0
Wend

' ===> Display the variable value to user
MsgBox "Your VAR_Name value = " + Inp1, 1, "DialogHeader: Ok Cancel"
MsgBox "Your VAR_Name value = " + Inp1, 2, "DialogHeader: Abort Retry Ignore"
MsgBox "Your VAR_Name value = " + Inp1, 3, "DialogHeader: Yes No Cancel"
MsgBox "Your VAR_Name value = " + Inp1, 4, "DialogHeader: Yes No"
MsgBox "Your VAR_Name value = " + Inp1, 5, "DialogHeader: RETRY Cancel"

' ===> Ask user to continue
IntMsgRtrn = MsgBox ("Do you want to Continue...", vbYesNo, "DialogHeader")
if IntMsgRtrn = vbNo Then
MsgBox "You selected NO"
Else
MsgBox "You selected YES"
End If

End Sub

To read from Microsoft Excel:

Language: CATScript / VBScript / VBA


Sub CATMain()

On Error Resume Next

Set xl = GetObject(, "EXCEL.Application")
If err.Number <> 0 Then
Set xl = CreateObject("EXCEL.Application")
xl.Visible = True
End If

MsgBox xl.ActiveSheet.Range("A1").Value

End Sub

To read from Microsoft Excel:

Language: CATScript / VBScript / VBA


Sub CATMain()

On Error Resume Next

Set xl = GetObject(, "EXCEL.Application")
If err.Number <> 0 Then
Set xl = CreateObject("EXCEL.Application")
xl.Visible = True
End If

MsgBox xl.ActiveSheet.Range("A1").Value

End Sub

To Write to a text file:

Language: CATScript / VBScript / VBA
__________________________________________________________

Dim sFileOutput as String
Dim oFileOutput As File
Dim oStream As TextStream

sFileOutput = "C:\outputdir\outputfile.txt"

Set oFileOutput = CATIA.FileSystem.CreateFile(sFileOutput, True) 'Create the output file, at the location "sFileOutput"
'The "False" in the above command: Boolean value that is True if an existing file with the same name can be overwritten; False if it is not, and the creation doesn't take place.

Set oStream = oFileOutput.OpenAsTextStream("ForWriting") 'Opens the file for text writing.

oStream.Write "Anything put here will be written to the text file" & chr(10)
oStream.Write "To make a new line in the text file, use chr(10)" & chr(10) & "this text is on the next line"

oStream.Close
__________________________________________________________

~Joe

To Write to a text file:

Language: CATScript / VBScript / VBA
__________________________________________________________

Dim sFileOutput as String
Dim oFileOutput As File
Dim oStream As TextStream

sFileOutput = "C:\outputdir\outputfile.txt"

Set oFileOutput = CATIA.FileSystem.CreateFile(sFileOutput, True) 'Create the output file, at the location "sFileOutput"
'The "False" in the above command: Boolean value that is True if an existing file with the same name can be overwritten; False if it is not, and the creation doesn't take place.

Set oStream = oFileOutput.OpenAsTextStream("ForWriting") 'Opens the file for text writing.

oStream.Write "Anything put here will be written to the text file" & chr(10)
oStream.Write "To make a new line in the text file, use chr(10)" & chr(10) & "this text is on the next line"

oStream.Close
__________________________________________________________

~Joe

HIDE/SHOW STUFF :


Sub CATMain()

Set productDocument1 = CATIA.ActiveDocument

Set selection1 = productDocument1.Selection
'_______________________________________________________________
' HIDE all 'axis-systems'

CATIA.StatusBar = "Hidding axis-systems ..."

' ===> You can try to do a SEARCH manually before putting this string below "'Part Desig'.'Axis System', all".
' ===> Make use of Advance search menu under edit search.

selection1.Search "'Part Design'.'Axis System',all"

' ===> SetShow 1 = HIDE; 0 = SHOW.
selection1.VisProperties.SetShow 1


CATIA.StatusBar = "Done axis-systems ..."
'_______________________________________________________________



'_______________________________________________________________
' ===> COPY PASTE the above block to hide/show another set of entity type (search).
'_______________________________________________________________


' ===> Set the Status bar back to default.
CATIA.StatusBar = "Select an Object or a command"

End Sub

Change collor of dimensions in drawing...

Language="VBSCRIPT"

Sub CATMain()

Dim drawingDocument1 As Document
Set drawingDocument1 = CATIA.ActiveDocument

'~ ******* select all dimensions in drawing
Dim selection1 As Selection
Set selection1 = drawingDocument1.Selection

selection1.Search "CATDrwSearch.DrwDimension,all"
'~ ******* change the color of selection (in this case will be magenta -RGB code 255,0,255)
Set visPropertySet1 = selection1.VisProperties
visPropertySet1.SetRealColor 255,0,255,0
selection1.Clear
'~ *******
End Sub

Search forbidden chars in strings.
I use this procedure to scan in CATIA V5, components, bodies, etc. (ie: NAMECHECKER(PartBody.Name) )


Sub NAMECHECKER(kString)

' Allowed Characters (Airbus allowed chars in this case)
'-------------------------
' . Chr(46)
' - Chr(45)
' _ Chr(95)
' Numbers range Chr(48) to Chr(57)
' Upper case letters Chr(65) to Chr(90)
' Lower case letters Chr(97) to Chr(122)

' char by char...
For i = 1 To Len(kString)

' Extracts ascii code
kAscii = Asc(Mid(kString,i,1))

' Comparison with allowed chars
Select Case kAscii

Case 45
Case 46
Case 95
Case 48 To 57
Case 65 To 90
Case 97 To 122
Case Else

MsgBox "Warning - String: " & kString & " Character: " & Chr(kAscii)

End Select

Next

End Sub


----------------------
Kike

Change Line Type in all views or in few selected views

Language="VBSCRIPT"

Sub CATMain()

Dim drawingDocument1 As Document
Set drawingDocument1 = CATIA.ActiveDocument


'-------------- generated items
Dim selection4 As Selection
Set selection4 = drawingDocument1.Selection

selection4.Search "CATDrwSearch.CATEarlyGenItem,all"

Set visProperties1 = CATIA.ActiveDocument.Selection.VisProperties
visProperties1.SetRealLineType 1,0.2 '-----------change line type

Set visProperties1 = CATIA.ActiveDocument.Selection.VisProperties
visProperties1.SetRealWidth 1,0.2 '-----------change width



End Sub

If you want to change only a selected view you have to change the line

selection4.Search "CATDrwSearch.CATEarlyGenItem,all"

with

selection4.Search "CATDrwSearch.CATEarlyGenItem,sel"

To promote easily ready code I would recommend that we adopt a format to use to create well documented scripts like:

Option Explicit
' COPYRIGTH COE 2006
' ***********************************************************************
' Purpose: Creates constraints between assembly Parts using Publications
' Assumptions: Looks for xxxxx.CATProduct in the DocView
' Author:
' Languages: VBScript
' Locales: English
' CATIA Level: V5R6
' ***********************************************************************

Sub CATMain()

End Sub

Sub InsertExistingComponentAtPoint()

'VBA Code by Steven Kwok 08-02-06
'Insert Existing Component At A Point using SelectElement2
'For the exclusive use of COE members as a reference tool: Code Snippet
'Works with all licenses
'Written in CatiaV5R14

'Setting Variables
Dim partDocument1
Dim product1
Dim products1
Dim InputObjectType(1)
Dim Status
Dim SelectedPoints(999)
Dim MySelection
Dim HowManyParts As Integer
Dim Errer As Integer
Dim i As Integer

'Clear Error Codes
Errer = 0

'Reset Integer i
i = 0

'Set Active Document Information
Set partDocument1 = CATIA.ActiveDocument
Set product1 = partDocument1.Product
Set products1 = product1.Products
Set constraints1 = product1.Connections("CATIAConstraints")

'Select a file
fpath = CATIA.FileSelectionBox("Select an existing part!", "*.CATPart", CatFileSelectionModeOpen)
If fpath = "" Then
Errer = 1
GoTo ErrerCodes
End If

'Instantiate picked component
Dim arrayOfVariantOfBSTR1(0)
arrayOfVariantOfBSTR1(0) = fpath
products1.AddComponentsFromFiles arrayOfVariantOfBSTR1, "All"

Set MySelection = partDocument1.selection

'Choose an Object Type (Must be in this order Vertex=0, Point=1, no idea why)
'Select any non-geometric point from screen (ie: corner, sketch point, etc)
InputObjectType(0) = "Vertex"
'Select any geometric set point on screen or from tree
InputObjectType(1) = "Point"

'Clear Selection from memory so user can choose one
MySelection.Clear
Status = MySelection.SelectElement2(InputObjectType(), "Select a Point", False)
If (Status <> "Normal") Then
Errer = 2
GoTo ErrerCodes
End If

'Get reference name from selection
Set SelectedPoints(i) = MySelection.Item(1).Value
Set Part1Product = MySelection.FindObject("CATIAProduct")
Set Part1Assembly = Part1Product.Parent

'Get reference name from instantiated component
HowManyParts = products1.Count
Set Part2Product = products1.Item(HowManyParts)

'Create references and constrain them using a coincidence constraint
Set reference1 = product1.CreateReferenceFromName(Part1Assembly.Name & "/" & Part1Product.Name & "/!" & SelectedPoints(0).Name)
Set reference2 = product1.CreateReferenceFromName(Part1Assembly.Name & "/" & Part2Product.Name & "/!Origin")

'Moves instantiated component origin to selected point
'Switching reference1 and reference2 will do the opposite
Set constraint1 = constraints1.AddBiEltCst(catCstTypeOn, reference2, reference1)
product1.Update

ErrerCodes:
If (Errer = 1) Then
MsgBox "No file selected, program terminating."
End If

If (Errer = 2) Then
MsgBox "No point selected, program terminating."
End If

If (Errer = 0) Then
MsgBox "Code complete." & sLF & "Finished at " & Time
End If

End Sub

R14 sp5 tested and works sample catia and excel file attached

1 .asks user for a excel sheet name
2. opens an excel process
3. moves the active sheet selected by user
4. saves the document
5. closes excel process



Sub CATMain()

Dim Excel As Object
Dim workbooks As workbooks
Dim workbook As workbook
Dim Sheets As Object
Dim Sheet As Object
Dim worksheet As Excel.worksheet

Err.Clear
On Error Resume Next
Set Excel = GetObject(, "EXCEL.Application")
If Err.Number <> 0 Then
Err.Clear
Set Excel = CreateObject("EXCEL.Application")
End If
Set workbooks = Excel.Application.workbooks
Set myworkbook = workbooks.Add("C:\Documents and Settings\mjeeves\Desktop\design table tests\MULTISHEET.xls")
Set myworksheet = ActiveWorkbook.Item(1)

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


'Asks for Name of the required Active Sheet

WhichSheet = inputBox ("Type Model year Ie 07,08,09,10,11....")


'Setting The Active Sheet
Set myWorkSheet = myWorkbook.Worksheets.Item(WhichSheet)
myWorkSheet.Activate


Set lastSheet = myWorkbook.Worksheets(myWorkbook.Worksheets.Count)
call myWorkSheet.Select
call myWorkSheet.Move ( ,lastSheet)
call myWorkSheet.SaveAs("C:\Documents and Settings\mjeeves\Desktop\design table tests\MULTISHEET.xls")

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'close routine:

Application.DisplayAlerts = False

workbook.Close
Excel.Quit
Set workbook = Nothing
Set workbooks = Nothing
Set Excel = Nothing

Application.DisplayAlerts = True

End Sub

- Identify components in a product -


Language="VBSCRIPT"

Sub CATMain()

Set productDocument1 = CATIA.ActiveDocument
Set product1 = productDocument1.Product

Set products1 = product1.Products

For i = 1 To products1.Count

NameOfProdPart = products1.Item(i).ReferenceProduct.Parent.Name

If Right(NameOfProdPart,7) = "CATPart" Then

Msgbox "Part! " & NameOfProdPart

Elseif Right(NameOfProdPart,7) = "Product" Then


If NameOfProdPart = product1.Name & ".CATProduct" Then

Msgbox "Component! " & NameOfProdPart

Else

Msgbox "Product! " & NameOfProdPart

End If

End If

Next

End Sub

A batch convert - CATPart to STP (Windows)

Language="VBSCRIPT"
Sub CATMain()
folderinput = InputBox ("Take your files from here","Input","C:\tempin\",2000,4000)
folderoutput = InputBox ("Put your files here","Output","C:\tempout\",2000,4000)

Dim fs, f, f1, fc, s
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderinput)Set fc = f.Files

For Each f1 in fc

Dim PartDocument1 'As Document
Set documents1 = CATIA.Documents

Dim document1 'As Document

INTRARE = folderinput & f1.name
Set PartDocument1 = CATIA.Documents.Open(INTRARE)

IESIRE = folderoutput & f1.name & ".stp"
PartDocument1.ExportData IESIRE, "stp"

s = s & f1.name
s = s & vbCrLf

CATIA.ActiveDocument.Close
Next

End Sub


Of course you can do a lot of combinations just replacing stp with something else sopported by ExportData or combination like CATDrawing (instead of CATPart) to pdf (instead of stp). Just be careful to create the necessary folders....

Same batch convert but here is the UNIX version - CATPart to STP

Language="VBSCRIPT"
Sub CATMain()
folderinput = InputBox ("Take your files from here","Input","/home/tempin/",2000,4000)
folderoutput = InputBox ("Put your files here","Output","/home/tempout/",2000,4000)

Dim fs, f, f1, fc, s As FileSystem
Set fs = CATIA.FileSystemSet f = fs.
GetFolder(folderinput)Set fc = f.Files

For Each f1 in fc

Dim PartDocument1 'As Document
Set documents1 = CATIA.Documents
Dim document1 'As Document
INTRARE = folderinput & f1.name
Set PartDocument1 = CATIA.Documents.Open(INTRARE)

IESIRE = folderoutput & f1.name & ".stp"
PartDocument1.ExportData IESIRE, "stp"

s = s & f1.name
s = s & vbCrLf

CATIA.ActiveDocument.Close
Next

End Sub

Modifying view scale (UNIX)

A CATScript which will modify views scale. The macro will skip the views which are not created and will do the job in the order specified in the message box.

Sub CATMain()

MsgBox "First 2 inputs are for Main View Scale and Background View Scale: Even if you will modify these 2 scales, you will not notice any modifications, that's why implicit value is 1. 1st value is for Main, 2nd for Background, 3rd for Front, 4th for Top, 5th for Up, 6th for Left, 7th for Right, 8th for ISO. Use only double value, do NOT use 1:2 or 1/2 (for example) "

Dim theDrawing As DrawingDocument
Set theDrawing = CATIA.ActiveDocument
Dim aSheet As DrawingSheet
Dim aView As DrawingView
Dim i As Integer, j As Integer

For i = 1 To theDrawing.Sheets.count
Set aSheet = theDrawing.Sheets.Item(i)
For j = 1 To aSheet.Views.count
Set aView = aSheet.Views.Item(j)

' Retrieve the drawing components collection of the target drawing view
Dim o2DComponents As DrawingComponents
Set o2DComponents = aView.Components

'Gets the View Scale;

aView.Scale = InputBox("Enter drawing scale", "scale", "1")
If aView.Scale = "" Then
MsgBox "The Macro has been aborted."
Exit Sub
End If

Next
Next

End Sub