How to add a vertex to several 3DPolyline (overlapped) with only one command?

[Anonymous]

Hello to All,

I'm looking for a command or lisp, that allows me to add a vertex to several 3D polylines ( overlapped ) at once, only with one command.

I suppose that it must be an easy way of solving this issue. For instance, if we want to stretch several 3Dpoly ( overlapped ) we can do this just by clicking on the grip and dragging, so at the end, I think that it should be possible doing this just by selecting all the 3dpoly and passing the cursor over the grip we want to add another vertex.

It should pop up a menu ( like you can see if only you select one 3Dpoly ).

Thank You so much for Your help, this's really something that I'm looking for ages and I can't find a solution.

Domingos.

[ВeekeeCZ]

Post that as a dwg with states before and after.

[Anonymous]

Hi there,

please find attached the dwg file with a several 3Dpoly, if we want to stretch several 3Dpoly ( overlapped ) we can do this just by clicking on the grip and dragging, so at the end, I think that it should be possible doing this just by selecting all the 3dpoly and passing the cursor over the grip we want to add another vertex.

It should pop up a menu ( like you can see if only you select one 3Dpoly ).

Thank You so much for Your help, this is something that is very important to my work ( and my mental health 🙂

Domingos Morgado

[doaiena · Accepted solution]

If i understood you correctly, this will work for you:

;; Insert Nth  -  Lee Mac
;; Inserts an item at the nth position in a list.
;; x - [any] Item to be inserted
;; n - [int] Zero-based index at which to insert item
;; l - [lst] List in which item is to be inserted

(defun LM:insertnthFlat ( x n l / i )
    (setq i -1)
    (apply 'append (mapcar '(lambda ( a ) (if (= n (setq i (1+ i))) (list (car x) (cadr x) (caddr x) a) (list a))) l))
)
;Small modification made to Lee Mac's function to flatten the list

(defun c:test ( / ss pt ctr obj param verts pos arr)

(prompt "\nSelect Polylines: ")
(if (and (setq ss (ssget '((0 . "POLYLINE")))) (setq pt (getpoint "\nPick a point on a polyline to add a vertex: ")))
(progn
(setq ctr 0)
(repeat (sslength ss)
(setq obj (vlax-ename->vla-object (ssname ss ctr)))

(if (setq param (vlax-curve-getparamatpoint obj pt))
(progn
(setq verts (vlax-safearray->list (variant-value (vla-get-coordinates obj))))
(setq pos (* (+ (fix param) 1) 3))
(setq verts (LM:insertnthFlat pt pos verts))
(setq arr (vlax-make-safearray vlax-vbDouble (cons 0 (- (length verts) 1))))
(vlax-safearray-fill arr verts)
(vla-put-coordinates obj arr)

));if point is on the pline
(setq ctr (1+ ctr))
);repeat

))
(princ)
);defun

[Anonymous]

Hello Doaiena,

It works just fine 🙂 It allows me to add a vertex to several 3D polylines ( overlapped ) at once, with only one command/ lisp.

Thank You so much, You really saved my day 🙂

Have a Great Weekend

Domingos Morgado

[ebaartmanGKL77]

Does this have to be a 3d Polyline? 

[ebaartmanGKL77]

I ended up finding another lisp routine I could modify from MOHITGAUR on CADTUTOR: https://www.cadtutor.net/forum/topic/74629-lisp-for-add-vertex-on-intersecting-3d-polyline-with-elev...

but, my polylines have object data that I want to retain, and this doesn't seem to add verticies and retain the OD

[CADaSchtroumpf]

@ebaartmanGKL77 

Try with these modifications on your code, it should preserve the object data.

[ebaartmanGKL77]

Thank you so much @CADaSchtroumpf!

[CADaSchtroumpf]

@ebaartmanGKL77 

Another way that doesn't destroy object data.

(defun l-coor2l-pt (obj lst flag / )
  (if lst
    (cons
      (list
        (car lst)
        (cadr lst)
        (if flag
          (+ (if (vlax-property-available-p obj 'Elevation) (vlax-get obj 'Elevation) 0.0) (caddr lst))
          (if (vlax-property-available-p obj 'Elevation) (vlax-get obj 'Elevation) 0.0)
        )
      )
      (l-coor2l-pt obj (if flag (cdddr lst) (cddr lst)) flag)
    )
  )
)
(defun c:add_vertex-3D ( / ss AcDoc Space obj_vla l_coor last_p pt pt_vtx new_vtx prm indx flag nw_coor)
  (princ "\nSelecting an unfited 3Dpolyline")
  (while (null (setq ss (ssget "_+.:E:S" '((0 . "POLYLINE") (-4 . "<AND") (-4 . "&") (70 . 8)  (-4 . "<NOT") (-4 . "&") (70 . 4) (-4 . "NOT>") (-4 . "AND>"))))))
  (setq
    AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
    Space
    (if (eq (getvar "CVPORT") 1)
      (vla-get-PaperSpace AcDoc)
      (vla-get-ModelSpace AcDoc)
    )
    obj_vla (vlax-ename->vla-object (ssname ss 0))
    l_coor (l-coor2l-pt obj_vla (vlax-get obj_vla 'Coordinates) T)
    last_p (last l_coor)
  )
  (initget 8)
  (while (setq pt (getpoint "\nNew vertex at point: "))
    (setq
      pt_vtx (vlax-curve-getClosestPointToProjection obj_vla (trans pt 1 0) '(0 0 1) nil)
      new_vtx (vlax-3d-point last_p)
      prm (vlax-curve-getParamAtPoint obj_vla pt_vtx)
      indx -1
    )
    (cond
      ((and (not (equal pt_vtx (vlax-curve-getStartPoint obj_vla) 1E-08)) (not (equal pt_vtx (vlax-curve-getEndPoint obj_vla) 1E-08)))
        (vla-AppendVertex obj_vla new_vtx)
        (repeat (if (vlax-curve-isClosed obj_vla) (fix (vlax-curve-getEndParam obj_vla)) (1+ (fix (vlax-curve-getEndParam obj_vla))))
          (setq indx (1+ indx))
          (if (or (not (eq indx (1+ (fix prm)))) flag)
            (setq nw_coor (cons (vlax-curve-getPointAtParam obj_vla indx) nw_coor))
            (setq nw_coor (cons pt_vtx nw_coor) indx (1- indx) flag T)
          )
        )
        (setq indx -1)
        (foreach e (reverse nw_coor)
          (vlax-put-property obj_vla 'Coordinate (setq indx (1+ indx)) (vlax-3d-point e))
        )
        (setq
          l_coor (l-coor2l-pt obj_vla (vlax-get obj_vla 'Coordinates) T)
          last_p (last l_coor)
          nw_coor nil
          flag nil
        )
        (sssetfirst nil ss)
      )
      (T (princ "\nSame point at one end."))
    )
    (initget 8)
  )
  (sssetfirst nil nil)
  (prin1)
)

[sameerulcdc]

hi 

thank you for this lsp it save my time 
i need one more modification of this one can we select multiple line in one time ( not one line)

thank you  

[ebaartmanGKL77]

This is the code I ended up with to do multiple vertices, I put notes in the code for what I changed from the code 

@CADaSchtroumpf had posted

[CADaSchtroumpf]

---

@sameerulcdc  a écrit :

hi 

thank you for this lsp it save my time 
i need one more modification of this one can we select multiple line in one time ( not one line)

thank you  

---

On which lisp?

If it is on add_vertex-3D, here is the modification made:

(defun l-coor2l-pt (obj lst flag / )
  (if lst
    (cons
      (list
        (car lst)
        (cadr lst)
        (if flag
          (+ (if (vlax-property-available-p obj 'Elevation) (vlax-get obj 'Elevation) 0.0) (caddr lst))
          (if (vlax-property-available-p obj 'Elevation) (vlax-get obj 'Elevation) 0.0)
        )
      )
      (l-coor2l-pt obj (if flag (cdddr lst) (cddr lst)) flag)
    )
  )
)
(defun c:add_vertex-3D ( / AcDoc Space ss n ent obj_vla l_coor last_p pt pt_vtx new_vtx prm indx flag nw_coor)
  (setq
    AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
    Space
    (if (eq (getvar "CVPORT") 1)
      (vla-get-PaperSpace AcDoc)
      (vla-get-ModelSpace AcDoc)
    )
  )
  (princ "\nSelecting unfited 3Dpolyline")
  (cond
    ((setq ss (ssget '((0 . "POLYLINE") (-4 . "<AND") (-4 . "&") (70 . 8) (-4 . "<NOT") (-4 . "&") (70 . 4) (-4 . "NOT>") (-4 . "AND>"))))
      (repeat (setq n (sslength ss))
        (setq
          ent (ssname ss (setq n (1- n)))
          obj_vla (vlax-ename->vla-object ent)
          l_coor (l-coor2l-pt obj_vla (vlax-get obj_vla 'Coordinates) T)
          last_p (last l_coor)
        )
        (sssetfirst nil (ssadd ent (ssadd)))
        (initget 8)
        (while (setq pt (getpoint "\nNew vertex at point: "))
          (setq
            pt_vtx (vlax-curve-getClosestPointToProjection obj_vla (trans pt 1 0) '(0 0 1) nil)
            new_vtx (vlax-3d-point last_p)
            prm (vlax-curve-getParamAtPoint obj_vla pt_vtx)
            indx -1
          )
          (cond
            ((and (not (equal pt_vtx (vlax-curve-getStartPoint obj_vla) 1E-08)) (not (equal pt_vtx (vlax-curve-getEndPoint obj_vla) 1E-08)))
              (vla-AppendVertex obj_vla new_vtx)
              (repeat (if (vlax-curve-isClosed obj_vla) (fix (vlax-curve-getEndParam obj_vla)) (1+ (fix (vlax-curve-getEndParam obj_vla))))
                (setq indx (1+ indx))
                (if (or (not (eq indx (1+ (fix prm)))) flag)
                  (setq nw_coor (cons (vlax-curve-getPointAtParam obj_vla indx) nw_coor))
                  (setq nw_coor (cons pt_vtx nw_coor) indx (1- indx) flag T)
                )
              )
              (setq indx -1)
              (foreach e (reverse nw_coor)
                (vlax-put-property obj_vla 'Coordinate (setq indx (1+ indx)) (vlax-3d-point e))
              )
              (setq
                l_coor (l-coor2l-pt obj_vla (vlax-get obj_vla 'Coordinates) T)
                last_p (last l_coor)
                nw_coor nil
                flag nil
              )
            )
            (T (princ "\nSame point at one end."))
          )
          (initget 8)
        )
        (sssetfirst nil nil)
      )
    )
    (T (princ "\nNo 3Dpolyline selected"))
  )
  (prin1)
)