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
Pmeasure
- Thread starter Al
- Start date
Jeff Mishler
Usenet Archive
- Joined
- Jul 3, 2003
- Messages
- 987
- Reaction score
- 0
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 c
meas (/ 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)
)
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 c
meas (/ 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))
