[script] remove points closest to the given value

[dh42]

Hello,

This script is designed to remove points closest to the given value in a polyline.

it's an experiment to clean the polylines that results of a picture digit (to remove the stairs)

Code: [Select]

   ' remove points closest to the given value
  
    Sub main()
        Dim rep As String
        Dim tol As Double
        Dim p As polyline
        Dim nbpt1 As Integer

        CamBamConfig.Defaults.ReloadTreeAfterScript = False

        rep = inputbox("Max distance between 2 points", , 0)

        tol = val(rep)

        If CamBamUI.MainUI.ActiveView.SelectedEntities.Length > 0 Then


            For Each ent As Entity In CamBamUI.MainUI.ActiveView.SelectedEntities

                If TypeOf ent Is Polyline Then

                    p = ent

                    CamBamUI.MainUI.UndoBuffer.AddUndoPoint("RemovePoints")
                    CamBamUI.MainUI.UndoBuffer.Add(ent)

                    nbpt1 = p.Points.Count

                    If p.RemoveDuplicatePoints(tol) = True Then

                        App.Log("Polyline: " & ent.ID & "  #Points before: " & nbpt1 & "  #Points after: " & p.Points.Count & "  #Points removed: " & nbpt1 - p.Points.Count)

                    End If

                    p.Update()

                End If

            Next ent


            CamBamUI.MainUI.ActiveView.RefreshView()

        End If

    End Sub
++
David