Adding vertex to segments of polylines that are greater than a specified length

[enthralled]

Hello,

Can anyone help me with a way to automate the following steps:

 

1- User Selects multiple polylines

2- User inputs a number for maximum length of polyline segments

3- Lisp Finds segments within the polylines that are greater than a user specified length

4.a- Lisp Adds a vertex at mid point of each of these segments

4.b- If 1 vertex at mid point is not enough to achieve a length below the specified max, then it will add vertices that are equidistant (having uniform lengths, see attached image for clarification)

Note that the polylines must keep their original properties (layrer/color, etc), including direction/orientation (start/end).

Attached Image to show result (dimensions only for clarification, not needed in the lisp) + Sample CAD drawing.

 

The closest that I found is this:  maxsegmentlength.lsp by dlanorh (although it adds vertex exactly at distance, instead of dividing the segment equally).

Thanks.

Bhannes Network.dwg

Edited January 18, 2023 by enthralled

[Tsuky]

This?

(vl-load-com)
(defun add_vtx (obj add_pt ent_name / bulg)
  (vla-addVertex
    obj
    (1+ (fix add_pt))
    (vlax-make-variant
      (vlax-safearray-fill
        (vlax-make-safearray vlax-vbdouble (cons 0 1))
          (list
            (car (trans (vlax-curve-getpointatparam obj add_pt) 0 ent_name))
            (cadr (trans (vlax-curve-getpointatparam obj add_pt) 0 ent_name))
          )
      )
    )
  )
  (setq bulg (vla-GetBulge obj (fix add_pt)))
  (vla-SetBulge obj
    (fix add_pt)
    (/
      (sin (/ (* 4 (atan bulg) (- add_pt (fix add_pt))) 4))
      (cos (/ (* 4 (atan bulg) (- add_pt (fix add_pt))) 4))
    )
  )
  (vla-SetBulge obj
    (1+ (fix add_pt))
    (/
      (sin (/ (* 4 (atan bulg) (- (1+ (fix add_pt)) add_pt)) 4))
      (cos (/ (* 4 (atan bulg) (- (1+ (fix add_pt)) add_pt)) 4))
    )
  )
  (vla-update obj)
)
(defun c:div-vertex_po ( / ss max_l n ent obj_vla pr dist_end dist_start seg_len div l_div l)
  (princ "\nSelect polylines.")
  (while (null (setq ss (ssget '((0 . "LWPOLYLINE")))))
    (princ "\nSelect is empty, or isn't POLYLINE!")
  )
  (initget 7)
  (setq max_l (getdist "\nMax length between vertex: "))
  (repeat (setq n (sslength ss))
    (setq
      ent (ssname ss (setq n (1- n)))
      obj_vla (vlax-ename->vla-object ent)
      pr (fix (vlax-curve-getEndParam ent))
    )
    (repeat (fix (vlax-curve-getEndParam ent))
      (setq
        dist_end (vlax-curve-GetDistAtParam ent pr)
        dist_start (vlax-curve-GetDistAtParam ent (setq pr (1- pr)))
        seg_len (- dist_end dist_start)
        div (1+ (fix (/ seg_len max_l)))
        l_div (/ seg_len div)
        l l_div
      )
      (while (< l seg_len)
        (add_vtx obj_vla (vlax-curve-getparamatdist ent (- dist_end l)) ent)
        (setq l (+ l l_div))
      )
    )
  )
  (prin1)
)

 

Edited January 18, 2023 by Tsuky

[enthralled]

15 hours ago, Tsuky said:

This?

(vl-load-com)
(defun add_vtx (obj add_pt ent_name / bulg)
  (vla-addVertex
    obj
    (1+ (fix add_pt))
    (vlax-make-variant
      (vlax-safearray-fill
        (vlax-make-safearray vlax-vbdouble (cons 0 1))
          (list
            (car (trans (vlax-curve-getpointatparam obj add_pt) 0 ent_name))
            (cadr (trans (vlax-curve-getpointatparam obj add_pt) 0 ent_name))
          )
      )
    )
  )
  (setq bulg (vla-GetBulge obj (fix add_pt)))
  (vla-SetBulge obj
    (fix add_pt)
    (/
      (sin (/ (* 4 (atan bulg) (- add_pt (fix add_pt))) 4))
      (cos (/ (* 4 (atan bulg) (- add_pt (fix add_pt))) 4))
    )
  )
  (vla-SetBulge obj
    (1+ (fix add_pt))
    (/
      (sin (/ (* 4 (atan bulg) (- (1+ (fix add_pt)) add_pt)) 4))
      (cos (/ (* 4 (atan bulg) (- (1+ (fix add_pt)) add_pt)) 4))
    )
  )
  (vla-update obj)
)
(defun c:div-vertex_po ( / ss max_l n ent obj_vla pr dist_end dist_start seg_len div l_div l)
  (princ "\nSelect polylines.")
  (while (null (setq ss (ssget '((0 . "LWPOLYLINE")))))
    (princ "\nSelect is empty, or isn't POLYLINE!")
  )
  (initget 7)
  (setq max_l (getdist "\nMax length between vertex: "))
  (repeat (setq n (sslength ss))
    (setq
      ent (ssname ss (setq n (1- n)))
      obj_vla (vlax-ename->vla-object ent)
      pr (fix (vlax-curve-getEndParam ent))
    )
    (repeat (fix (vlax-curve-getEndParam ent))
      (setq
        dist_end (vlax-curve-GetDistAtParam ent pr)
        dist_start (vlax-curve-GetDistAtParam ent (setq pr (1- pr)))
        seg_len (- dist_end dist_start)
        div (1+ (fix (/ seg_len max_l)))
        l_div (/ seg_len div)
        l l_div
      )
      (while (< l seg_len)
        (add_vtx obj_vla (vlax-curve-getparamatdist ent (- dist_end l)) ent)
        (setq l (+ l l_div))
      )
    )
  )
  (prin1)
)

 

Thanks, works perfect.

Much appreciated!