AutoLISP - Insert vertex at midpoint on polyline segment inside selection

[ChybaKpisz]

I want to make selection and add vertices at midpoints (red crosses) for all segments inside of selection box.

Or in other words - divide all single-segmented parts of polyline inside of selection to 2-segmented.

 

I was looking for this specific routine but did't find it.

 

Edited November 3, 2022 by ChybaKpisz

[Tsuky]

Perhaps 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:AddVtx@tMid ( / pt1 pt2 js AcDoc Space pt_l min_x max_x min_y max_y n ename obj prm pt pt_n-1)
  (initget 1)
  (setq pt1 (getpoint "\nPick corner first point: "))
  (initget 33)
  (setq pt2 (getcorner pt1 "\nPick corner opposite: "))
  (princ "\nSelect polylines.")
  (setq js (ssget "_C" pt1 pt2 '((0 . "LWPOLYLINE"))))
  (cond
    (js
      (setq
        AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
        Space
        (if (= 1 (getvar "CVPORT"))
          (vla-get-PaperSpace AcDoc)
          (vla-get-ModelSpace AcDoc)
        )
        pt_l (list pt1 pt2)
        min_x (apply 'min (mapcar 'car pt_l))
        max_x (apply 'max (mapcar 'car pt_l))
        min_y (apply 'min (mapcar 'cadr pt_l))
        max_y (apply 'max (mapcar 'cadr pt_l))
      )
      (vla-startundomark AcDoc)
      (repeat (setq n (sslength js))
        (setq
          ename (ssname js (setq n (1- n)))
          obj (vlax-ename->vla-object ename)
          prm (vlax-curve-getEndParam obj)
        )
        (repeat (fix prm)
          (setq
            pt (trans (vlax-curve-getPointAtParam obj prm) 0 1)
            pt_n-1 (trans (vlax-curve-getPointAtParam obj (1- prm)) 0 1)
          )
          (cond
            ((and
              (> (car pt) min_x) (< (car pt) max_x)
              (> (cadr pt) min_y) (< (cadr pt) max_y)
              (> (car pt_n-1) min_x) (< (car pt_n-1) max_x)
              (> (cadr pt_n-1) min_y) (< (cadr pt_n-1) max_y)
             )
              (setq prm (- prm 0.5))
              (add_vtx obj prm ename)
              (setq prm (- prm 0.5))
            )
            (T (setq prm (1- prm)))
          )
        )
      )
      (vla-endundomark AcDoc)
      (sssetfirst nil js)
    )
  )
  (prin1)
)

 

[ChybaKpisz]

YES! That's exactly what I need. Thank you so much.