Jump to content

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

enthralled

By enthralled
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

enthralled Enthusiast

enthralled

Posted
Posted (edited)

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.

maxlengthsegments.jpg

Bhannes Network.dwgFetching info...

Edited by enthralled
Tsuky Community Regular

Tsuky

Posted
Posted (edited)

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 by Tsuky
  • Like 3
  • Thanks 1
enthralled Enthusiast

enthralled

Posted
  • Author
Posted
  On 1/18/2023 at 4:09 PM, 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)
)

 

Expand  

Thanks, works perfect.

Much appreciated!

  • 2 years later...
enthralled Enthusiast

enthralled

Posted
  • Author
Posted
  On 1/18/2023 at 4:09 PM, 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)
)

 

Expand  

 

When running the above on a poyline with segment length exactly = 10 and specifying a max length between vertex of 1, it's adding vertex every 0.9091 instead of adding every 1. Is there an easy fix? Thanks!

LanloyLisp Enthusiast

LanloyLisp

Posted
Posted
  On 3/18/2025 at 7:13 AM, enthralled said:

 

When running the above on a poyline with segment length exactly = 10 and specifying a max length between vertex of 1, it's adding vertex every 0.9091 instead of adding every 1. Is there an easy fix? Thanks!

Expand   
(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 (if (zerop (rem seg_len max_l))(fix (/ seg_len max_l))(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)
)

Hi enthralled, check the quick fix above.

enthralled Enthusiast

enthralled

Posted
  • Author
Posted (edited)
  On 3/18/2025 at 8:44 AM, LanloyLisp said: 
(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 (if (zerop (rem seg_len max_l))(fix (/ seg_len max_l))(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)
)

Hi enthralled, check the quick fix above.

Expand  

Thanks, here's my result (attached DWG + Screenshot), still not working as intended. 0.91 and 0.96 segments should instead be =1 :

Screenshot2025-03-18105742.thumb.png.ccf94df65c7f4d3b37cf90549307e9aa.png

div-vertex_po.dwgFetching info...

Edited by enthralled
LanloyLisp Enthusiast

LanloyLisp

Posted
Posted
  On 3/18/2025 at 9:02 AM, enthralled said:

Thanks, here's my result (attached DWG + Screenshot), still not working as intended. 0.91 and 0.96 segments should instead be =1 :

Screenshot2025-03-18105742.thumb.png.ccf94df65c7f4d3b37cf90549307e9aa.png

div-vertex_po.dwg 61.46 kB Â· 0 downloads

Expand   
(defun NearestINT (num f / i r)
  ;; num - real / integer
  ;; f - fuzz
  (setq i (float (fix num))
        r (- num i))
  (cond
    ((< r f) i)
    ((> r (abs (1- f))) (1+ i))
    (T num)
  )
)

(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 (fix (/ (nearestint seg_len 1e-4) 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)
)

check above, hopefully, this one is will working now. NearestINT function has been added, you can adjust it to your desired precision

enthralled Enthusiast

enthralled

Posted
  • Author
Posted
  On 3/18/2025 at 11:44 AM, LanloyLisp said: 
(defun NearestINT (num f / i r)
  ;; num - real / integer
  ;; f - fuzz
  (setq i (float (fix num))
        r (- num i))
  (cond
    ((< r f) i)
    ((> r (abs (1- f))) (1+ i))
    (T num)
  )
)

(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 (fix (/ (nearestint seg_len 1e-4) 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)
)

check above, hopefully, this one is will working now. NearestINT function has been added, you can adjust it to your desired precision

Expand  

Hi, sorry for taking from your time.

Now I'm getting segments greater than the specified max (1). If there's no easy fix, then it's okay. Thanks.

This is the result:

Screenshot2025-03-19074557.png.99710b958519a91e5e9b40df9110c985.png

div-vertex_po_2.dwgFetching info...

LanloyLisp Enthusiast

LanloyLisp

Posted
Posted 
(defun NearestINT (num f / i r)
  ;; num - real / integer
  ;; f - fuzz
  (setq i (float (fix num))
        r (- num i))
  (cond
    ((< r f) i)
    ((> r (abs (1- f))) (1+ i))
    (T num)
  )
)

(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_len1 seg_len2 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_len1 (- dist_end dist_start)
	seg_len2 (nearestint seg_len1 1e-4)
        div (if (equal (fix seg_len2) seg_len2 0.0)(fix (/  seg_len2 max_l))(1+ (fix (/  seg_len2 max_l))))
        l_div (/ seg_len2 div)
        l l_div
      )
      (while (< l seg_len2)
        (add_vtx obj_vla (vlax-curve-getparamatdist ent (- dist_end l)) ent)
        (setq l (+ l l_div))
      )
    )
  )
  (prin1)
)

Hi enthralled, please try the 3rd revision.

  • Like 1
enthralled Enthusiast

enthralled

Posted
  • Author
Posted
  On 3/19/2025 at 7:41 AM, LanloyLisp said: 
(defun NearestINT (num f / i r)
  ;; num - real / integer
  ;; f - fuzz
  (setq i (float (fix num))
        r (- num i))
  (cond
    ((< r f) i)
    ((> r (abs (1- f))) (1+ i))
    (T num)
  )
)

(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_len1 seg_len2 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_len1 (- dist_end dist_start)
	seg_len2 (nearestint seg_len1 1e-4)
        div (if (equal (fix seg_len2) seg_len2 0.0)(fix (/  seg_len2 max_l))(1+ (fix (/  seg_len2 max_l))))
        l_div (/ seg_len2 div)
        l l_div
      )
      (while (< l seg_len2)
        (add_vtx obj_vla (vlax-curve-getparamatdist ent (- dist_end l)) ent)
        (setq l (+ l l_div))
      )
    )
  )
  (prin1)
)

Hi enthralled, please try the 3rd revision.

Expand  

Thanks it works!

At some places, the lisp is creating vertices at locations where a vertex already exists before running the lisp, resulting in duplicate vertex with zero length segments. can this be avoided?

enthralled Enthusiast

enthralled

Posted
  • Author
Posted
  On 3/19/2025 at 7:41 AM, LanloyLisp said: 
(defun NearestINT (num f / i r)
  ;; num - real / integer
  ;; f - fuzz
  (setq i (float (fix num))
        r (- num i))
  (cond
    ((< r f) i)
    ((> r (abs (1- f))) (1+ i))
    (T num)
  )
)

(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_len1 seg_len2 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_len1 (- dist_end dist_start)
	seg_len2 (nearestint seg_len1 1e-4)
        div (if (equal (fix seg_len2) seg_len2 0.0)(fix (/  seg_len2 max_l))(1+ (fix (/  seg_len2 max_l))))
        l_div (/ seg_len2 div)
        l l_div
      )
      (while (< l seg_len2)
        (add_vtx obj_vla (vlax-curve-getparamatdist ent (- dist_end l)) ent)
        (setq l (+ l l_div))
      )
    )
  )
  (prin1)
)

Hi enthralled, please try the 3rd revision.

Expand  

I tried asking Gemini for a fix for both, the max length issue and duplicate nodes, I got the following, I don't know how well it achieves the result, but it works, do you think it's okay to use:
  

;; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/add-vertex-to-2d-3d-plines-depending-on-a-specific-distance/m-p/11688584/highlight/true#M442151

;; https://www.cadtutor.net/forum/topic/76685-adding-vertex-to-segments-of-polylines-that-are-greater-than-a-specified-length/#comment-610360

;; modified by "gemini-2.0-flash-thinking-exp-01-21" To enforce the specified maximum segment length and prevent duplicate vertices, the code was modified to use ceiling division for segmenting and to check for existing vertices before adding new ones.


(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:AVPLSX ( / ss max_l n ent obj_vla pr dist_end dist_start seg_len div l_div l new_vtx_pt existing_vtx_coords vtx_index pt_param tol)

  (vla-startundomark (vla-get-ActiveDocument (vlax-get-acad-object))) ; Start undo mark here

  (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: "))
  (setq tol 1e-8) ; Define tolerance for comparing points
  (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)))

        div (if (= max_l 0.0) 1 (max 1 (1+ (fix (- (/ seg_len max_l) 0.0000000001)))))
        l_div (/ seg_len div)
        l l_div
      )
      (while (< l seg_len)
        (setq new_vtx_pt (vlax-curve-getpointatdist ent (- dist_end l)))
        (setq pt_param (vlax-curve-getParamAtPoint ent new_vtx_pt))
        (setq existing_vtx_coords nil) ; Initialize existing vertex coordinates list
        (setq vtx_index 0)
        (while (<= vtx_index (fix (vlax-curve-getEndParam ent))) ; Iterate through existing vertices
          (setq existing_vtx_pt (vlax-curve-getpointatparam ent vtx_index))
          (if (equal existing_vtx_pt new_vtx_pt tol) ; Check if existing vertex is at new point within tolerance
              (progn
                (setq existing_vtx_coords T) ; Mark that a vertex exists
                (setq vtx_index (1+ (fix (vlax-curve-getEndParam ent)))) ; Exit loop
              )
              (setq vtx_index (1+ vtx_index))
          )
        )
        (if (not existing_vtx_coords) ; If no existing vertex found, add new vertex
          (add_vtx obj_vla (vlax-curve-getparamatdist ent (- dist_end l)) ent)
        )
        (setq l (+ l l_div))
      )
    )
  )

  (vla-endundomark (vla-get-ActiveDocument (vlax-get-acad-object))) ; End undo mark

  (prin1)
)

 

LanloyLisp Enthusiast

LanloyLisp

Posted
Posted
  On 3/19/2025 at 8:02 AM, enthralled said:

I tried asking Gemini for a fix for both, the max length issue and duplicate nodes, I got the following, I don't know how well it achieves the result, but it works, do you think it's okay to use:
  

;; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/add-vertex-to-2d-3d-plines-depending-on-a-specific-distance/m-p/11688584/highlight/true#M442151

;; https://www.cadtutor.net/forum/topic/76685-adding-vertex-to-segments-of-polylines-that-are-greater-than-a-specified-length/#comment-610360

;; modified by "gemini-2.0-flash-thinking-exp-01-21" To enforce the specified maximum segment length and prevent duplicate vertices, the code was modified to use ceiling division for segmenting and to check for existing vertices before adding new ones.


(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:AVPLSX ( / ss max_l n ent obj_vla pr dist_end dist_start seg_len div l_div l new_vtx_pt existing_vtx_coords vtx_index pt_param tol)

  (vla-startundomark (vla-get-ActiveDocument (vlax-get-acad-object))) ; Start undo mark here

  (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: "))
  (setq tol 1e-8) ; Define tolerance for comparing points
  (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)))

        div (if (= max_l 0.0) 1 (max 1 (1+ (fix (- (/ seg_len max_l) 0.0000000001)))))
        l_div (/ seg_len div)
        l l_div
      )
      (while (< l seg_len)
        (setq new_vtx_pt (vlax-curve-getpointatdist ent (- dist_end l)))
        (setq pt_param (vlax-curve-getParamAtPoint ent new_vtx_pt))
        (setq existing_vtx_coords nil) ; Initialize existing vertex coordinates list
        (setq vtx_index 0)
        (while (<= vtx_index (fix (vlax-curve-getEndParam ent))) ; Iterate through existing vertices
          (setq existing_vtx_pt (vlax-curve-getpointatparam ent vtx_index))
          (if (equal existing_vtx_pt new_vtx_pt tol) ; Check if existing vertex is at new point within tolerance
              (progn
                (setq existing_vtx_coords T) ; Mark that a vertex exists
                (setq vtx_index (1+ (fix (vlax-curve-getEndParam ent)))) ; Exit loop
              )
              (setq vtx_index (1+ vtx_index))
          )
        )
        (if (not existing_vtx_coords) ; If no existing vertex found, add new vertex
          (add_vtx obj_vla (vlax-curve-getparamatdist ent (- dist_end l)) ent)
        )
        (setq l (+ l l_div))
      )
    )
  )

  (vla-endundomark (vla-get-ActiveDocument (vlax-get-acad-object))) ; End undo mark

  (prin1)
)

 

Expand  

It seems perfectly fine and much better. (vla-get-ActiveDocument (vlax-get-acad-object)) - this can be set to a variable.

  • Like 1
enthralled Enthusiast

enthralled

Posted
  • Author
Posted
  On 3/19/2025 at 9:47 AM, LanloyLisp said:

It seems perfectly fine and much better. (vla-get-ActiveDocument (vlax-get-acad-object)) - this can be set to a variable.

Expand  

Thank a lot! ðŸ™‚

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...