hi @Babak.moussavian
try this
Sub CreateSurfaceLoads()
Dim RobApp As RobotApplication
If NotReady(RobApp) Then Exit Sub
Dim ObjNum As Long, CasNum As Integer, A As Double, B As Double
ObjNum = [ObjNo].Value2: CasNum = [CasNo].Value2
A = [DimA].Value2: B = [DimB].Value2: S = A * B: A2 = A / 2: B2 = B / 2
Dim AUTO_DETECT As Boolean: AUTO_DETECT = [AUTO_DETECT_OBJECTS].Value2
Dim Cases As RobotCaseServer, SimpleCase As RobotSimpleCase, Records As RobotLoadRecordMngr
Set Cases = RobApp.Project.Structure.Cases
Set SimpleCase = Cases.Get(CasNum)
Set Records = SimpleCase.Records
Dim rec As IRobotLoadRecord2, RecInContour As RobotLoadRecordInContour
RecordsCnt = Records.Count
For i = RecordsCnt To 1 Step -1
Set rec = Records.Get(i)
Select Case rec.Type
Case IRobotLoadRecordType.I_LRT_POINT_AUXILIARY
Dim p As Point, xm As Double, xp As Double, ym As Double, yp As Double
With rec 'IRobotPointAuxiliaryRecordValues
FZS = .GetValue(I_PARV_FZ) / S
p.X = .GetValue(I_PARV_X): p.Y = .GetValue(I_PARV_Y): p.Z = .GetValue(I_PARV_Z)
End With
xm = p.X - A2: xp = p.X + A2: ym = p.Y - B2: yp = p.Y + B2
With Records
.Delete i: Set RecInContour = .Create(I_LRT_IN_CONTOUR)
End With
With RecInContour 'IRobotInContourRecordValues
If Not AUTO_DETECT Then .Objects.FromText ObjNum Else .SetValue I_ICRV_AUTO_DETECT_OBJECTS, 1
.SetVector 0, 0, 1
.SetValue I_ICRV_PZ1, FZS
.SetValue I_ICRV_PZ2, FZS
.SetValue I_ICRV_PZ3, FZS
.SetPoint 1, xm, yp, p.Z
.SetPoint 2, xm, ym, p.Z
.SetPoint 3, xp, ym, p.Z
.SetValue I_ICRV_NPOINTS, 4
.SetContourPoint 1, xm, yp, p.Z
.SetContourPoint 2, xm, ym, p.Z
.SetContourPoint 3, xp, ym, p.Z
.SetContourPoint 4, xp, yp, p.Z
End With
End Select
Next i
RobApp.Project.ViewMngr.Refresh
Set RobApp = Nothing
End Sub
Best Regards
Msg updated