SelSurfDup

From scripting
Jump to: navigation, search
Sub SelSurfDup(SurfArr As Variant)
Dim SecArr()
ReDim SecArr(0)

For X = 0 To UBound(SurfArr)
    If HasArea(SurfArr(X)) Then
        Dim CMeas
        Set CMeas = TheSPAWorkbench.GetMeasurable(SurfArr(X))
        Dim CPerimeter As Double
        CPerimeter = CMeas.Perimeter
        Dim CArea As Double
        CArea = CMeas.Area
        Dim CCOG(2)
        CMeas.GetCOG CCOG
        
        For Y = X + 1 To UBound(SurfArr)
            If HasArea(SurfArr(Y)) Then
                Dim NMeas
                Set NMeas = TheSPAWorkbench.GetMeasurable(SurfArr(Y))
                Dim NPerimeter As Double
                NPerimeter = NMeas.Perimeter
                Dim NArea As Double
                NArea = NMeas.Area
                Dim NCOG(2)
                NMeas.GetCOG NCOG
                
                If NPerimeter = CPerimeter And CArea = NArea And NCOG(0) = CCOG(0) And NCOG(1) = CCOG(1) And  NCOG(2) = CCOG(2) Then
                    Set SecArr(UBound(SecArr)) = SurfArr(Y)
                    ReDim Preserve SecArr(UBound(SecArr) + 1)
                End If
            End If
        Next Y
    End If
Next X 

For Z = 0 To UBound(SecArr) - 1
    MyHSFactory.DeleteObjectForDatum SecArr(Z)
Next Z
End Sub