Zoom to vertex

[ebsoares]

Hi, all.

A few days back I asked for a routine that cycled through each vertex in a polyline (works with 3d polys and splines as well), asking the user to strech each one. A forum user graciously helped me with that request and I marked the solution as a solution.

However, the routine randomly does not do what it's supposed to do, and I can't figure out why. Sometimes when the user streches a vertex, the routine will simply place it a few hundred units away instead of at the picked spot (snaps are turned off). Other times we see the routine zoom to a vertex and, for some unknown reason, skip to the next one, then the next, then the next, untill it reaches one it thinks it's okay to let the user edit it. Sometimes it works as it should...

I am not very savvy with lisp routines (can do just simple, basic stuff) and was wondering if someone might be able to help refine the one we got.

Here's the code I got, with a few little edits:

(defun c:EditZoom ( / *error* getinfo ucsf es e pl ppl p pp n )

	(vl-load-com)

	(defun *error* ( msg )
		(if ucsf
			(command "_.UCS" "_P")
		)
		(if msg
			(prompt msg)
		)
		(princ)
	)
 
	(defun getinfo ( es )
		(setq e (car es) pl nil)
		(cond 	( 	(eq (cdr (assoc 0 (entget e))) "LWPOLYLINE")
				(setq pl (mapcar '
						(lambda ( p ) (trans (list (car p) (cadr p) (cdr (assoc 38 (entget e)))) e 0))
						(mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (eq (car x) 10)) (entget e)))
					)
				)
			es
			)
			( 	(eq (cdr (assoc 0 (entget e))) "POLYLINE")
				(setq v e)
				(while (setq v (entnext v))
					(if (eq (cdr (assoc 0 (entget v))) "VERTEX")
						(setq pl (cons (cdr (assoc 10 (entget v))) pl))
					)
				)
				(setq pl (reverse pl))
				es
			)
			( 	(eq (cdr (assoc 0 (entget e))) "SPLINE")
				(setq pl (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (eq (car x) 11)) (entget e)))
				)
			es
			)
			( 	(or (eq (cdr (assoc 0 (entget e))) "ARC") (eq (cdr (assoc 0 (entget e))) "ELLIPSE")
					(eq (cdr (assoc 0 (entget e))) "LINE")
				)
				(setq pl (cons (vlax-curve-getendpoint e) pl)
					pl (cons (vlax-curve-getstartpoint e) pl)
				)
				(if (not (equal (car pl) (cadr pl) 1e-8))
					es
					(progn
						(prompt "\nWrong entity pick...")
						(setq es (entsel "\nPick element with vertices to edit-stretch them"))
						(setq es (getinfo es))
					)
				)
			)
			( t
				(prompt "\nWrong entity pick...")
				(setq es (entsel "\nPick element with vertices to edit-stretch them"))
				(setq es (getinfo es))
			)
		)
	)

	(if (eq (getvar 'worlducs) 0)
		(progn
			(command "_.UCS" "_W")
			(setq ucsf t)
		)
	)
	(setq es (entsel "\nPick element with vertices to edit-stretch them"))
	(setq e (car es))
	(print)
	(prompt "\nZoom & edit vertex. To skip to next vertex type the \"@\" character, or ESC to finish.")
	(while (and es (setq es (getinfo es)))
		(if (null p)
			(progn
				(setq p (cadr es))
				(setq ppl (vl-sort pl '(lambda ( a b ) (< (distance p a) (distance p b)))))
				(setq n (vl-position (car ppl) pl))
			)
			(repeat (setq n (rem (1+ n) (length pl)))
				(setq pl (cdr (reverse (cons (car pl) (reverse pl)))))
			)
		)
		(if (null pp)
			(setq pp (car ppl))
			(setq pp (car pl))
		)
		(command "_.ZOOM" "_C" "_non" pp)
		(while (< 0 (getvar 'cmdactive)) (command ""))
		(command "_.STRETCH" "_C" "_non" pp "_non" pp "" "")
		(while (< 0 (getvar 'cmdactive)) (command "\\"))
	)
	(princ)
)

I'd appreciate any help 🙂

Edgar

[doglips]

I haven't had a chance to ;look closely but it could be (prompt "\nZoom & edit vertex. To skip to next vertex type the \"@\" character..........

Generally the at "@" in AutoCAD refers to the last point selected. It could account for the problem of stretching and finding it was moved

[ebsoares]

Hi, doglips.

I haven't been making much use of the "@" symbol when running that routine. I even went into the lisp code to try and change it to something else, but couldn't find where I could do that - it would be nice to use a single keystroke letter instead of two (Shift+2 = "@"), like "n" for next and "p" for previous.

Still, even without using that, the routine still fails from time to time...

Regards,

Edgar