Pmeasure

I once had this lisp routine that would place a block or point a set
distance along a polyline. Somehow it invloved a command ".measure" and
erasing all the points or blocks generated after the first measured point.
Does anyone still have this routine? it was called PMEASURE.lsp

 

I don't have that routine, but I was able to put together this little
routine. It will place a point at the entered distance along any type of
Pline, Line, Spline or Arc. The command prompt for the distance also
shows you the length of the object and will only allow distances to be
entered that will place a point on the object.
It measures along the object in the direction it was created, so if you
want the point a certain distance from the end of the object vs the
beginning, enter a negative value.

I'm posting the code rather than attaching the file since it looks like
the web interface is still not using attachments properly.

HTH,
Jeff

;| Routine to measure along an object and place a Point Node
at that point. Works with Plines, Splines, Lines and Arcs
Jeff Mishler Dec. 2003
|;

(defun cmeas (/ coords doc ent newdist objpoly pnt len test)
(vl-load-com)
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark doc)
(while (not ent)
(initget "X")
(setq ent (entsel "\nSelect object to measure or e[X]it:"))
(cond ((not ent)(princ "\nYou missed, try again..."))
((= ent "X")(princ "...exiting..."))
(t (princ))
)
)
(if (and ent
(/= ent "X")
(wcmatch (strcase (cdr (assoc 0 (entget (car ent)))))
"*LINE,ARC")
)
(progn
(if (not pdist)
(setq pdist 0.0)
)
(setq objPoly (vlax-ename->vla-object (car ent))
len (vlax-curve-getdistAtParam objPoly
(vlax-curve-getEndParam objPoly))
)
(if (> pdist len)(setq pdist 0))
(while (not test)
(setq newdist
(getreal
(strcat "\nDistance along object, "
(rtos len) " units long, to measure:["
(rtos pdist) "] "))
test t)
(if (/= newdist nil)
(progn
(if (> newdist len)
(progn
(princ "\nPoint does not lie on the object, try again.")
(setq test nil)
)
)
(if (minusp newdist)
(setq pdist (+ len newdist))
(setq pdist newdist)
)
)
)
)
(setq coords (vlax-curve-getPointAtDist objPoly pdist)
pnt (vla-addpoint
(if (= 1 (vla-get-activespace doc))
(vla-get-modelspace doc);we're in modelspace
(if (= (vla-get-mspace doc) :vlax-true)
(vla-get-modelspace doc);we're in modelspace
;thru paperspace VPort
(vla-get-paperspace doc);we're in paperspace
)
)
(vlax-3d-point coords)))
;do whatever you want with the point object, "pnt", here
;such as change the layer, color whatever.....
)
(princ "\nYou didn't select a measurable object, try again.")
)
(vla-endundomark doc)
(princ)
)

 

Thanks, Jeff!

rs

 

Thanks and Happy Holidays!