Macro is running more and more slowly

[rookiezzz]

Hello everyone:

I have developed a macro to extract the closest face from a body against a 3D point.
The principle is to loop through each face and to use SPA workbench, measure and return the closest face.
I find it runs more and more slowly, because I have more than 1000 points, for example, if point 1 against body1 which has 8000 faces, it may takes 20 sec.
Then if point 800 against same body1, it may takes 1 hours...
What's the problem, could anybody help review my code. Many thanks.
Is there the issue related to cache? I reset the selection for each loop and DeleteObjectForDatum for useless object.

Here is the code.

Sub CATMain()
CATIA.HSOSynchronized = true
CATIA.RefreshDisplay = false
Set objXL = CreateObject("Excel.Application")
Msgbox ("Choose SW Check doc.")
Datei=CATIA.FileSelectionBox("Choose SW Check doc.", "*.xlsm", CatFileSelectionModeOpen)
objXL.Workbooks.Open Datei
objXL.Visible = True
objXL.ActiveSheet.Activate

Dim oDoc As PartDocument
Dim oSel As Selection
set oCurrentTreeNode = Catia.activedocument.product
set opart = oCurrentTreeNode.referenceproduct.parent.part
set part1 = Catia.activedocument.part
Dim hybridShapeFactory1 As Factory
Set hybridShapeFactory1 =Catia.activedocument.part.HybridShapeFactory
Set oDoc = CATIA.ActiveDocument

rowcount = objXL.ActiveSheet.usedrange.rows.count
for kk = 3 to rowcount
t = ""
Set hybridShapePointCoord1 = hybridShapeFactory1.AddNewPointCoord(objXL.ActiveSheet.cells(kk,2),objXL.ActiveSheet.cells(kk,3), objXL.ActiveSheet.cells(kk,4))
hybridShapePointCoord1.compute
set referencepoint = Catia.activedocument.part.CreateReferenceFromGeometry(hybridShapePointCoord1)
for pp = 1 to 3
if objXL.ActiveSheet.cells(kk,4*pp + 1) <> "" then
bodyname = objXL.ActiveSheet.cells(kk,4*pp + 1)
err.clear
Set body1 = part1.bodies.Item(left(bodyname,len(bodyname)-1) & right(bodyname,1))
on error resume next
if left(bodyname,len(bodyname)-1) & right(bodyname,1) = left(body1.name,len(body1.name)-1) & right(body1.name,1) then
Set oSel = oDoc.Selection
oSel.add(body1)
oSel.Search "Topology.face,sel"
x =20000
for i = 1 to oSel.count
Set referenceSurface = oSel.item(i).value
Set TheSPAWorkbench = CATIA.ActiveDocument.GetWorkbench("SPAWorkbench")
Set TheMeasurable = TheSPAWorkbench.GetMeasurable(referencepoint)
MinimumDistance = TheMeasurable.GetMinimumDistance(referencesurface)
if MinimumDistance < x then
x = MinimumDistance
Set referencesurfaceclosest = oSel.item(i).value
end if
next
Set hybridShapeExtract1 = hybridShapeFactory1.AddNewExtract(referencesurfaceclosest)
hybridShapeExtract1.PropagationType = 3
hybridShapeExtract1.ComplementaryExtract = False
hybridShapeExtract1.IsFederated = False
hybridShapeExtract1.compute
Set bodies1 = CATIA.ActiveDocument.part.Bodies
Set body1 = bodies1.Item("PartBody")
hybridShapeExtract1.name = objXL.ActiveSheet.cells(kk,1) & " - " & objXL.ActiveSheet.cells(kk,4*pp + 1)
body1.InsertHybridShape hybridShapeExtract1
part1.InWorkObject = hybridShapeExtract1
part1.Update

Set hybridShapeLineNormal1 = hybridShapeFactory1.AddNewLineNormal(referencesurfaceclosest, referencepoint, -5.000000, 5.000000, False)
hybridShapeLineNormal1.compute
Set referenceauxline = Catia.activedocument.part.CreateReferenceFromGeometry(hybridShapeLineNormal1)
oSel.clear
oSel.add(hybridShapeExtract1)
oSel.Search ("Topology.CGMEdge,sel")
x = 20000
for i = 1 to oSel.count
Set referenceedge = oSel.item(i).value
Set TheMeasurable = TheSPAWorkbench.GetMeasurable(referenceauxline)
MinimumDistance = TheMeasurable.GetMinimumDistance(referenceedge)
if MinimumDistance < x then
x = MinimumDistance
end if
next
x = round(x,3)
objXL.ActiveSheet.cells(kk,4*pp + 3) = x
if objXL.ActiveSheet.cells(kk,22) = "" then
objXL.ActiveSheet.cells(kk,22) = x
else
if x<objXL.ActiveSheet.cells(kk,22) then objXL.ActiveSheet.cells(kk,22) = x
end if
else
objXL.ActiveSheet.cells(kk,4*pp + 3) = "Part not found"
end if
end if
next
hybridShapeFactory1.DeleteObjectForDatum referencepoint
hybridShapeFactory1.DeleteObjectForDatum referenceauxline
next

CATIA.RefreshDisplay = True
msgbox("Done")
End Sub

 

[Little Cthulhu]

Specify CATIA.HSOSynchronized=False

Minimize number of times you call Search. Get names of all bodies from Excel, group them by value and call Search for every unique body just once.

Moreover, you can add all bodies to Selection, perform a single Search and then group resulting elements by examining it's Parent.Name property

Why do you call GetMinimumDistance the second time?

 

[LWolf]

I usually try to

1. read a file into CATIA,
2. work on the data,
3. and then dump out the data into the file in one go.

and not go back and forth throughout the script execution...

 

[rookiezzz]

Specify CATIA.HSOSynchronized=False

Minimize number of times you call Search. Get names of all bodies from Excel, group them by value and call Search for every unique body just once.

Moreover, you can add all bodies to Selection, perform a single Search and then group resulting elements by examining it's Parent.Name property

Why do you call GetMinimumDistance the second time?

Thanks for your reply, I will take a try on your suggestion.
The second time I call GetMinimumDistance is to find the closest edge from the closest face.
I need both closest face and closest edge as output.

 

[rookiezzz]

I usually try to

1. read a file into CATIA,
2. work on the data,
3. and then dump out the data into the file in one go.

and not go back and forth throughout the script execution...

Thanks for your reply, I will try to optimize the code as you suggested.