Hello Everyone,
I have a macro that creates a sketch containing points (essential having position). It then inserts parts into that sketch to mate with those points. One part is opened and is inserted again and again. Now this works all fine till you have about 200-300 points. However the moment you go above 500 points macro slows down and keeps slowing down. I tried to look for optimizing the performance but was not very successful with it. These parts can be considered as sticks (cylindrical sticks -about 3 mm long) with pointed ends. These pointed ends and plane of the part are used for mating with points on the sketch. I am pasting the code below. I would highly appreciate any help on this subject.
Set swApp = Application.SldWorks
Set Part = swApp.OpenDoc6(pathprobe, 1, 0, "", longstatus, longwarnings)
Set Part = swApp.ActivateDoc2("ORIGIN-DUT.SLDASM", False, longstatus)
'=======================================================================================
'Set swApp = Application.SldWorks 'yyy
bRet = swApp.GetUserProgressBar(Progress)
Dim firstprobe As Boolean
Dim SketchPntArray As Variant
Dim ActiveSketch As Object
Dim ThisSketchpoint As Object
Dim res As Boolean
'Set Part = swApp.ActiveDoc 'yyy
Set SelMgr = Part.SelectionManager
retval = Part.SelectByID("Sketch1", "SKETCH", 0, 0, 0)
Part.EditSketch
Set ActiveSketch = Part.GetActiveSketch2()
SketchPntArray = ActiveSketch.GetSketchPoints()
Part.ActiveView.FrameState = 1
void = Part.SetDisplayWhenAdded(False)
Part.SetPickMode
Part.ClearSelection
Part.Insertsketch
bRet = Progress.Start(0, numofpoint, "Mounting Probes")
For i = 1 To numofpoint
If menu_broches = 1 Or (menu_broches = 2 And (i Mod Numorigin) = 1) Then 'Or (O(i) = 2 And menu_broches = 3)
Set Components = Part.AddComponent2(probenames & ".SLDPRT", 0, 0, 0)
SW_Name(i) = Components.Name
If O(i) = 2 Or O(i) = 1 Then
'***********Set red color for rotated pins***********************************
'Set Part = swApp.ActiveDoc
'Set SelMgr = Part.SelectionManager
'boolstatus = Part.Extension.SelectByID2("771-001110-xx-7@ORIGIN-DUT", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
'Dim Component As Object
'Set Component = Part.SelectionManager.GetSelectedObjectsComponent(1)
Components.MaterialPropertyValues = vMatProp
boolstatus = Part.EditRebuild3
'*****************************************************
End If
If firstprobe = True Then
selid = SW_Name(i) & "@" & Assem
If Not (Part.SelectByID(selid, "COMPONENT", 0, 0, 0)) Then
MsgBox "Unable to Select First probe.: " & selid, vbCritical + vbOKOnly, ".: Error :."
End If
Part.UnfixComponent
Part.ClearSelection
firstprobe = False
End If
selid = "Point1@Origin@" & SW_Name(i) & "@" & Assem
'====================Get Probe's ID===============================================
If Not (Part.SelectByID(selid, "EXTSKETCHPOINT", 0, 0, 0)) Then
MsgBox "Unable to Select tip of probe model.: " & selid, vbCritical + vbOKOnly, ".: Error :."
End If
Set ThisSketchpoint = SketchPntArray(SketchPointID(i))
Debug.Print " Array Values = " & SketchPntArray(SketchPointID(i))
TextBox1.Text = ThisSketchpoint.Value
If ThisSketchpoint.Select(True) = False Then
MsgBox "Unable to Select sketchpoint. " & SketchPointID(i), vbCritical + vbOKOnly, ".: Error :."
End If
'=================Mate probe and Sketch===============================================
Part.AddMate swMateCOINCIDENT, swMateAlignALIGNED, 0, 0, 0
Part.ClearSelection
'Mates plane with point
selid = "TOP@" & SW_Name(i) & "@" & Assem
res = Part.SelectByID(selid, "PLANE", 0, 0, 0)
res = Part.AndSelectByID(vplane, "PLANE", 0, 0, 0) ' for file format of SW 2006
res = Part.AddMate(swMateCOINCIDENT, swMateAlignALIGNED, 0, 0, 0)
'Part.HideComponent2
Part.ClearSelection
'================Mates finished=========================================================
XForm = Components.GetXform
dblTheetaCompZ = -1 * (Ang(i) * DegToRad)
'Take care of negative angles which do exist in some eng files !@#\$%^!
If dblTheetaCompZ < 0 Then
dblTheetaCompZ = dblTheetaCompZ + (Pi * 2)
End If
Select Case dblTheetaCompZ
Case 0 To (Pi / 2)
'the coords are in quadrant 1
NewXForm(0) = Cos(dblTheetaCompZ)
NewXForm(1) = 0
NewXForm(2) = Sin(dblTheetaCompZ)
'Y Vector
NewXForm(3) = -Sin(dblTheetaCompZ)
NewXForm(4) = 0
NewXForm(5) = Cos(dblTheetaCompZ)
Case (Pi / 2) To Pi
'the coords are in quadrant 2
NewXForm(0) = Cos(dblTheetaCompZ)
NewXForm(1) = 0
NewXForm(2) = Sin(dblTheetaCompZ)
'Y Vector
NewXForm(3) = -Sin(dblTheetaCompZ)
NewXForm(4) = 0
NewXForm(5) = Cos(dblTheetaCompZ)
Case Pi To (Pi * 3 / 2)
'the coords are in quadrant 3
NewXForm(0) = Cos(dblTheetaCompZ)
NewXForm(1) = 0
NewXForm(2) = Sin(dblTheetaCompZ)
'Y Vector
NewXForm(3) = -Sin(dblTheetaCompZ)
NewXForm(4) = 0
NewXForm(5) = Cos(dblTheetaCompZ)
Case Is > (Pi * 3 / 2)
'the coords are in quadrant 4
NewXForm(0) = Cos(dblTheetaCompZ)
NewXForm(1) = 0
NewXForm(2) = Sin(dblTheetaCompZ)
'Y Vector
NewXForm(3) = -Sin(dblTheetaCompZ)
NewXForm(4) = 0
NewXForm(5) = Cos(dblTheetaCompZ)
Case Else
swApp.SendMsgToUser2 strErrorMsg, swMbInformation, swMbOk
End Select
NewXForm(6) = 0
NewXForm(7) = 0
NewXForm(8) = 1
'Translation
NewXForm(9) = XForm(9) 'no translation
NewXForm(10) = XForm(10) 'no translation
NewXForm(11) = XForm(11) 'no translation
'Not sure what these are
NewXForm(12) = 1
NewXForm(13) = 0
NewXForm(14) = 0
NewXForm(15) = 0
XForm = NewXForm
Call Components.SetXform((XForm))
res = Components.SetSuppression(swComponentSuppressed) 'Suppress the components to increase speed
Set Components = Nothing
End If
' Xuo(i) = X(i)
' Yuo(i) = Y(i) + dt_low_up
'nvdat27July09
Xuo(i) = X(i) - dt_low_up * Sin(Ang(i) * DegToRad)
Yuo(i) = Y(i) + dt_low_up * Cos(Ang(i) * DegToRad)
Status = 100 * (i / numofpoint)
' ProgressBar1.Value = Status
Frm.Caption = "Mounting..." & Round(Status, 0) & " %"
Progress.UpdateProgress
Next
Progress.End
SolidworksApi macros