Hello Guys, I am learning CATIA

[Suneet Manoj]

Hello Guys,

I am learning CATIA VBA Macros. I have written a Script for the Automatic Bend Radius update for the Harnesses in the CATIA V5 EHI module.

But for some reason when I am changing the current value with a new value it is showing an error. ( the same script is working fine with diameter update)

Can you guys Please help me out with this?

ub UpdateCatiaDiameter(filename, specialFolders)

Dim poFileSys, Sheet, TimeStamp ', LogFile
Set poFileSys = CreateObject("Scripting.FileSystemObject")

Dim productDocument1 'As ProductDocument
Set productDocument1 = CATIA.ActiveDocument
Dim oRootProd 'As Product
Set oRootProd = productDocument1.Product
Dim selection1 'As Selection
Set selection1 = productDocument1.Selection
TimeStamp = Year(Now) & Right("0" & Month(Now), 2) & Right( "0" & Day(Now), 2) & "_"& Right("0" & Hour(Now), 2) & Right("0" & Minute(Now), 2) & "_"
FileName2 = specialFolders & "\Report_Diameter_Update_" & TimeStamp & oRootProd.PartNumber & ".xlsx"




Dim objExcel
Set objExcel = CreateObject("Excel.Application")
objExcel.Workbooks.Add

'Select the first sheet
Sheet = 1

'Bind to worksheet.
Set objSheet = objExcel.ActiveWorkbook.Worksheets(Sheet)

'Name the worksheet
objSheet.Name = "UpdatedDiameters"

objSheet.Cells(1, 1).Value = "Branchable Name"
objSheet.Cells(1, 2).Value = "Branch Segment"
objSheet.Cells(1, 3).Value = "PH Diameter"
objSheet.Cells(1, 4).Value = "Catia Diameter"
objSheet.Cells(1, 5).Value = "Updated Diameter"
objSheet.Range("A1:E1").Font.Bold = True
objSheet.Range("A1:E1").Interior.ColorIndex = 36


Dim fso
Dim File
Dim content
Dim Line

Set fso = CreateObject("Scripting.FileSystemObject")
Set File = fspenTextFile(filename, 1)

content = File.ReadAll

Dim dict
Dim row
Set dict = CreateObject("Scripting.Dictionary")
Set File = fspenTextFile(filename, 1)
row = 0
Do Until File.AtEndOfStream
Line = File.ReadLine
dict.Add row, Line
row = row + 1
Loop

File.Close
Dim s 'As String
Dim fields 'As String
Dim counter
counter = 1
Dim prod1 'As Product
Dim val, i, j, k
Dim myParameters 'As Parameters
For Each Line In dict.Items
If InStr(Line, ",") <> 0 Then
s = Line
fields = Split(s, ",")
selection1.Search "(Name=" & fields(1) & " & CATElectricalSearch.BundleSegment),all"
If selection1.Count = 0 Then
MsgBox "Object with name " & fields(1) & " not Found!"
Else

For j = 1 To selection1.Count
Set prod1 = selection1.Item(j).LeafProduct
Set myParameters = prod1.Parameters
call SetLocale(0)
Set val = myParameters.Item(prod1.PartNumber & "\Constraints\" & fields(1) & "\Bend Radius")
If GetLocale = 1036 Then
If (val.Value-Replace(fields(2),".",","))<0 Then
counter = counter + 1
objSheet.Cells(counter, 1).Value = fields(0)
objSheet.Cells(counter, 2).Value = fields(1)
objSheet.Cells(counter, 3).Value = fields(2)
objSheet.Cells(counter, 4).Value = val.Value
'SetLocale(1036)
val.Value = Replace(fields(2), ".", ",")
objSheet.Cells(counter, 5).Value = val.Value
Else
counter = counter + 1
objSheet.Cells(counter, 1).Value = fields(0)
objSheet.Cells(counter, 2).Value = fields(1)
objSheet.Cells(counter, 3).Value = fields(2)
objSheet.Cells(counter, 4).Value = val.Value
'SetLocale(1036)
End If
Else
If (val.Value-fields(2))<0 Then
counter = counter + 1
objSheet.Cells(counter, 1).Value = fields(0)
objSheet.Cells(counter, 2).Value = fields(1)
objSheet.Cells(counter, 3).Value = fields(2)
objSheet.Cells(counter, 4).Value = val.Value
val.Value = fields(2)
objSheet.Cells(counter, 5).Value = val.Value
Else
counter = counter + 1
objSheet.Cells(counter, 1).Value = fields(0)
objSheet.Cells(counter, 2).Value = fields(1)
objSheet.Cells(counter, 3).Value = fields(2)
objSheet.Cells(counter, 4).Value = val.Value
'SetLocale(1036)
End If
End If
Next
End If
End If
Next

 

[Suneet Manoj]

Specially it is showing error in the line :


val.Value=feilds(2)