Ken, you're quite welcome! I'm glad you like it and find it useful.
And just since you asked politely
here's the updated routine that allows multiple vertice to be added.
(defun c:add_contour_vertex (/ ent contour coords temp_pline pt closept param newcoords)
(defun getspace ()
(if (= (getvar "cvport") 1)
(vla-get-paperspace (vla-get-activedocument (vlax-get-acad-object)))
(vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
)
)
(and (setq ent (car (entsel "\Select contour: ")))
(eq (cdr (assoc 0 (entget ent))) "AECC_CONTOUR")
(setq contour (vlax-ename->vla-object ent))
(setq coords (vlax-get contour 'coordinates))
(setq temp_pline (vlax-invoke (getspace) 'addpolyline coords))
;;need to add a temporary pline, as the vlax-curve functions return
;;odd results with aecc_contours
(not (vla-put-visible temp_pline :vlax-false))
(WHILE (setq pt (getpoint "\nPick point for new vertex: "))
(setq pt (list (car pt)(cadr pt)(caddr coords)))
(setq closePt (vlax-curve-getclosestpointto temp_pline pt))
(setq param (fix (vlax-curve-getparamatpoint temp_pline closept)))
(repeat (1+ param)
(setq newcoords (append newcoords (list (car coords)(cadr coords)(caddr coords))))
(setq coords (cdddr coords))
)
(setq newcoords (append newcoords pt))
(while coords
(setq newcoords (append newcoords (list (car coords)(cadr coords)(caddr coords))))
(setq coords (cdddr coords))
)
(vlax-put contour 'coordinates newcoords)
(vlax-put TEMP_PLINE 'coordinates newcoords)
(SETQ COORDS NEWCOORDS
NEWCOORDS NIL)
)
(vla-delete temp_pline)
)
(princ)
)
Note again, however, that there is no provison made for error trapping. If the user cancels out instead of finishing the command, the invisible temporary pline the routine creates will be left in the drawing. I leave it up to you to add the appropriate error control
(What is requires isn't that hard to add, that's why I leave it for you.....you gotta learn something here, right?
)