Adding vertexes to a polyline

[stusic]

Hey all! I'm not great at AutoLISP (at all), so I thought I'd ask a favor from those more knowledgeable in programming...

I'm looking to create a LISP routine that will allow a user to add vertexes to a polyline. The catch is that the polyline will already have vertexes, so they need to be able to advance to the node where they want to insert them (so the polyline doesn't overlap).

Right now, we've got to start PEDIT, Edit Vertex, hit Next until it gets the vertex before where we want to insert, then choose Insert, if we want another one, choose Insert again, then hit Escape to exit. Not terrible, but there's hundreds of these plines -- every day...

It seems like a lot of work to add two vertexes to a pline... If it were as simple as picking the line, then clicking multiple "nearest" points, then enter to exit -- all without making the lines overlap -- it would be greeaaat!

Can some person with exceptional skills show me how to do this? If it helps, I've included a drawing of what I start with and what I'd like to end up with.

Thanks for any help you can give!

[CAB2k]

Try This:
;; Revised Version by CAB at TheSwamp.org for bulge & width
;; Revised by gile for coordinate systems transformations 09/16/2007
;; no error checking, i.e. locked layers
;; Only works with LWpolylines
;;
;; NOTE: this is a work in progress :)
;;


(defun c:addvertex (/ ent ew norm nw obj old_bulge pt-o pt-w sw vi vr)

;; K*BULGE by gile
;; Returns a bulge which is proportional to reference bulge
;; Arguments :
;; b: the reference bulge
;; k: lthe ratio (between arc lengthes or angles)
;; Exemple:
;; (k*bulge 1.0 0.5) -> 0.414214
(defun k*bulge (b k / a)
(setq a (atan b))
(/ (sin (* k a)) (cos (* k a)))
)

(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
(vla-StartUndoMark doc)

(setq ent (entsel "\n Select point on polyline to add vertex: "))
(if (and ent
(equal (assoc 0 (entget (car ent))) '(0 . "LWPOLYLINE"))
)
(progn
(setq norm (cdr (assoc 210 (entget (car ent)))) ; get the pline normal
pt-w (vlax-curve-getclosestpointto (car ent) (trans (cadr ent) 1 0)) ; new point (WCS)
pt-o (trans pt-w 0 norm) ; new point (OCS)
pt-o (list (car pt-o) (cadr pt-o)) ; 2D point
vr (vlax-curve-getparamatpoint (car ent) pt-w)
vi (fix vr) ; vertex index, one before picked point
vr (- vr vi) ; vertex remainder, at picked point
)

(setq obj (vlax-ename->vla-object (car ent))
old_bulge (vla-getbulge obj vi)
)
(vla-GetWidth obj vi 'sw 'ew) ; startWidth endWidth
(vlax-invoke obj 'AddVertex (1+ vi) pt-o) ; add new vertex
(if (equal sw ew 0.0001) ; update pline width
(vla-SetWidth obj (1+ vi) sw ew)
(progn ; width is a taper
(setq nw (* (+ sw ew) vr))
(vla-SetWidth obj vi sw nw)
(vla-SetWidth obj (1+ vi) nw ew)
)
)
(if (not (zerop old_bulge)) ; got a bulge
(progn ; update new segments with matching radius
(vla-setbulge obj vi (k*bulge old_bulge vr))
(vla-setbulge obj (1+ vi) (k*bulge old_bulge (- 1 vr)))
)
)
)

)
(vla-EndUndoMark doc)

(princ)
)
(prompt "\nAdd Vertex to LW plines loaded, AddVertex to run.")
(princ)

[stusic]

Sweet! You're the man! Muchas Gracias! :)

Try This:
;; Revised Version by CAB at TheSwamp.org for bulge & width
;; Revised by gile for coordinate systems transformations 09/16/2007
;; no error checking, i.e. locked layers
;; Only works with LWpolylines
;;
;; NOTE: this is a work in progress :)
;;


(defun c:addvertex (/ ent ew norm nw obj old_bulge pt-o pt-w sw vi vr)

;; K*BULGE by gile
;; Returns a bulge which is proportional to reference bulge
;; Arguments :
;; b: the reference bulge
;; k: lthe ratio (between arc lengthes or angles)
;; Exemple:
;; (k*bulge 1.0 0.5) -> 0.414214
(defun k*bulge (b k / a)
(setq a (atan b))
(/ (sin (* k a)) (cos (* k a)))
)

(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
(vla-StartUndoMark doc)

(setq ent (entsel "\n Select point on polyline to add vertex: "))
(if (and ent
(equal (assoc 0 (entget (car ent))) '(0 . "LWPOLYLINE"))
)
(progn
(setq norm (cdr (assoc 210 (entget (car ent)))) ; get the pline normal
pt-w (vlax-curve-getclosestpointto (car ent) (trans (cadr ent) 1 0)) ; new point (WCS)
pt-o (trans pt-w 0 norm) ; new point (OCS)
pt-o (list (car pt-o) (cadr pt-o)) ; 2D point
vr (vlax-curve-getparamatpoint (car ent) pt-w)
vi (fix vr) ; vertex index, one before picked point
vr (- vr vi) ; vertex remainder, at picked point
)

(setq obj (vlax-ename->vla-object (car ent))
old_bulge (vla-getbulge obj vi)
)
(vla-GetWidth obj vi 'sw 'ew) ; startWidth endWidth
(vlax-invoke obj 'AddVertex (1+ vi) pt-o) ; add new vertex
(if (equal sw ew 0.0001) ; update pline width
(vla-SetWidth obj (1+ vi) sw ew)
(progn ; width is a taper
(setq nw (* (+ sw ew) vr))
(vla-SetWidth obj vi sw nw)
(vla-SetWidth obj (1+ vi) nw ew)
)
)
(if (not (zerop old_bulge)) ; got a bulge
(progn ; update new segments with matching radius
(vla-setbulge obj vi (k*bulge old_bulge vr))
(vla-setbulge obj (1+ vi) (k*bulge old_bulge (- 1 vr)))
)
)
)

)
(vla-EndUndoMark doc)

(princ)
)
(prompt "\nAdd Vertex to LW plines loaded, AddVertex to run.")
(princ)

['gile']

Hi,

If you want to go further, you can see this one which allows to add a vertex outside the the existing polyline (select he segment on which add the vertex and specify the vertex location any where). It works with lwpolyline, old-style 2d polyline and 3d polyline.
Included in the attached file: DelVtx, a routine to remove a vertex from a polyline.

[stusic]

Hi,

If you want to go further, you can see this one which allows to add a vertex outside the the existing polyline (select he segment on which add the vertex and specify the vertex location any where). It works with lwpolyline, old-style 2d polyline and 3d polyline.
Included in the attached file: DelVtx, a routine to remove a vertex from a polyline.

I like that quite a bit better -- it lets you keep adding vertexes without re-initiating the command and allows you to place them somewhere other than the line (which is what I'm trying to do), but there is one problem: because I'm using widths to define arrowheads and other parts of the pline, it stretches those widths, making the arrowheads stretched. It's almost as though it's moving a vertex more than adding one...

Try it on the drawing I attached earlier and you'll see what I mean.

Anyway, the first one works great, the second one almost works better. Either way, thanks guys. :)

['gile']

You're right, I didn't worry about width,
I'll edit the routine when I'll have some time and post it again.
Already, you can read this thread :
http://www.theswamp.org/index.php?topic=18720.0
You'll find there a third routine by Joe Burke which seems to work as you want.

[T.Willey]

Here is my simple submittal.

(defun c:AddVertex (/ Sel Pt Obj CoordList cnt ParmPt cnt2 Ang tmpPt1 tmpPt2)
; Add vertex to an lwpolyline, where polyline is selected.

(if
(and
(setq Sel (entsel "\n Select polyline near where new vertex will be added: "))
(= (cdr (assoc 0 (entget (car Sel)))) "LWPOLYLINE")
(setq Pt (trans (vlax-curve-getClosestPointTo (car Sel) (trans (cadr Sel) 1 0)) 0 (car Sel)))
(setq Obj (vlax-ename->vla-object (car Sel)))
(setq CoordList (vlax-get Obj 'Coordinates))
)
(progn
(setq cnt 0)
(setq ParmPt 1)
(while (< (1+ cnt) (length CoordList))
(setq cnt2
(if (>= (setq cnt2 (+ 2 cnt)) (length CoordList))
(- cnt2 (length CoordList))
cnt2
)
)
(setq Ang
(angle
(setq tmpPt1
(list
(nth cnt CoordList)
(nth (1+ cnt) CoordList)
)
)
(setq tmpPt2
(list
(nth cnt2 CoordList)
(nth (1+ cnt2) CoordList)
)
)
)
)
(if
(or
(equal (angle Pt tmpPt1) Ang 0.000001)
(equal (angle Pt tmpPt2) Ang 0.000001)
)
(setq cnt (length CoordList))
(progn
(setq ParmPt (1+ ParmPt))
(setq cnt (+ 2 cnt))
)
)
)
(vlax-invoke Obj 'AddVertex ParmPt (list (car Pt) (cadr Pt)))
)
)
(princ)
)

['gile']

Here's the new code, it seems to work fine with widths now, adding or deleting vertices.
Notice that these routines work whatever the current UCS and the pline plane (for lw and 2d plines).

[stusic]

Here's the new code, it seems to work fine with widths now, adding or deleting vertices.
Notice that these routines work whatever the current UCS and the pline plane (for lw and 2d plines).

That's the one! That's the one! Perfect!

Oh, you have made my job soooo much easier. I can't thank you enough! Wondermous!!

['gile']

CAB shows me another problem, for those who works with LUNITS sysvar different from 2.
So here's a new version

[Tom Beauford]

For years I'd been using a macro that broke a polyline segment at midpoint then joined Last + Previous to add a vertex. Never could figure a way to delete one. This is much nicer!
Thanks,

[Mr Cory]

Same here, i saw the thread title and thought yes a chance to share, but no glad i didnt :Oops:

Cheers Gile!

[stusic]

It's amazing the simple little things I still think of that could just make my life sooo much easier... there's only so much that the latest software and newest techinology can do, the rest is up to the smrt coders out there.

I'm just glad I can find them here. :)

[Mr Cory]

I'm just glad I can find them here. :)

Seconded :beer:!