The Survey forum was seeming kind of lonely - no posts yet! - so here's one.
Here's a free gift that I've found can save hours. It's a routine that's designed for calc'ing and grading offset points for field stakeout. Its ideal use is for things like calc'ing offsets for curb and gutter in parking lots and similar tasks, where you have a bunch of horizontal linework, and spot elevations at angle points, PCs, etc., but no surface, profile, or 3D-polylines to work from. You select entities, enter the starting and ending elevations, and the routine will blast in equally-spaced points on a straight grade along the entity at an offset you specify, with a maximum distance between points that you specify.
Load the following lisp routine, and run it by typing "gradeobj".
Code:
; gradeObj.lsp v1.01
; Creates equally-spaced straight-graded offsets to entities at a
; user-specified offset distance from the entity, keeping points within
; a user-specified maximum distance of each other.
; Richard Sincovec v1.00 07/25/2004 initial version
; v1.01 08/07/2004 bug fixes
(vl-load-com)
(if (= nil vll-kCurve)
(vlax-import-type-library
:tlb-filename "landauto.tlb"
:methods-prefix "vll-"
:properties-prefix "vll-"
:constants-prefix "vll-"
) ;_ vlax-import-type-library
) ;_ if
(setq *GRADEOBJ:QUAD* (/ PI 2)) ; radians in a quadrant
(setq *GRADEOBJ:FUZZ* 0.00001) ; fuzz factor
; next function gets a point at a specified distance along an entity
; returns endpoint if specified distance is within "fuzz factor" of end
; returns nil if point is not on entity
(defun GRADEOBJ:getPointAtDist (entName dist / pt d)
(cond ((vlax-curve-getPointAtDist entName dist))
((setq d (vlax-curve-getDistAtParam
entName
(vlax-curve-getEndParam entName)
) ;_ vlax-curve-getDistAtParam
) ;_ setq
(cond ((equal dist 0 *GRADEOBJ:FUZZ*) (vlax-curve-getStartPoint entName))
((equal dist d *GRADEOBJ:FUZZ*) (vlax-curve-getEndPoint entName))
) ;_ cond
)
) ;_ cond
) ;_ defun
(defun GRADEOBJ:setOffset (offPoint elev / pnt d)
(setq
pnt (vll-add
cogoPoints
(vlax-3D-point (list (car offPoint) (cadr offPoint) elev))
vll-kCoordinateFormatXYZ
) ;_ vll-add
) ;_ setq
(if (= ptDescMode 1)
(progn
(setq d (getstring T
(strcat "\nDescription <" ptDesc ">: ")
) ;_ getstring
) ;_ setq
(if (> (strlen d) 0)
(setq ptDesc d)
(vll-setString cogoPref vll-kPntCreateDefaultDesc ptDesc)
) ;_ if
) ;_ progn
) ;_ if
(if (/= ptDescMode 2)
(vll-put-rawDescription pnt ptDesc)
) ;_ if
(vlax-release-object pnt)
) ;defun
(defun GRADEOBJ:azimuthAtParam (entity selPar / dvec)
(setq dvec (vlax-curve-getFirstDeriv entity selPar))
(angle '(0 0) dvec)
;; note: angle projected on xy plane
) ;defun GRADEOBJ:azimuthAtParam
; value of dir: -1 = clockwise, 1 = counterclockwise
(defun GRADEOBJ:offsetInDir (entity point dir offDist / ang par)
(if (= offDist 0)
(append point)
(progn
(setq par (vlax-curve-getParamAtPoint entity point)
ang (+ (* dir *GRADEOBJ:QUAD*) (GRADEOBJ:azimuthAtParam entity par))
) ;setq
(polar point ang offDist)
) ;progn
) ;if
) ;defun GRADEOBJ:offsetInDir
(defun GRADEOBJ:gradeEntity (e startel endel /
startPar endPar numSegs tLen
offDir selPoint ang offPoint
curPoint segLen deltaz curz
)
(setq selPoint (vlax-curve-getClosestPointTo (car e) (cadr e))
endPar (vlax-curve-getEndParam (car e))
tLen (vlax-curve-getDistAtParam (car e) endPar)
selLen (vlax-curve-getDistAtPoint (car e) selPoint)
numSegs (1+ (fix (/ tLen *GRADEOBJ:MAX_GAP*)))
) ;setq
(if (= (rem tLen *GRADEOBJ:MAX_GAP*) 0)
(setq numSegs (1- numSegs))
) ;_ if
(setq deltaz (/ (- endel startel) numSegs)
curz startel
) ;_ setq
; offDir=-1 when user selected closer to beginning of object
(if (< selLen (/ tLen 2))
(setq offDir -1
curDist 0
segLen (/ tLen numSegs)
) ;_ setq
(setq offDir 1
curDist tLen
segLen (* (/ tLen numSegs) -1)
) ;_ setq
) ;if
(repeat numSegs
(setq curPoint (GRADEOBJ:getPointAtDist (car e) curDist)
offPoint (GRADEOBJ:offsetInDir (car e) curPoint offDir *GRADEOBJ:OFFD*)
) ;setq
(GRADEOBJ:setOffset offPoint curz)
(setq curDist (+ curDist segLen)
curz (+ curz deltaz)
) ;_ setq
) ;repeat
(initget "Yes No")
(if (= (getKword "\nSet end point (Yes/No)? <No> ") "Yes")
(progn
(setq curPoint (GRADEOBJ:getPointAtDist (car e) curDist)
offPoint (GRADEOBJ:offsetInDir (car e) curPoint offDir *GRADEOBJ:OFFD*))
(GRADEOBJ:setOffset offPoint endel)
) ;progn
) ;if
) ;defun GRADEOBJ:gradeEntity
(defun c:gradeObj
(/ e startel endel
acadObj aeccApp aeccProj cogoPoints
cogoPref ptDescMode ptDesc lastel
)
(setq acadObj (vlax-get-acad-object)
aeccApp (vla-getInterfaceObject acadObj "Aecc.Application")
aeccProj (vll-get-activeProject aeccApp)
cogoPoints (vll-get-cogoPoints aeccProj)
cogoPref (vll-get-cogo (vll-get-preferences aeccProj))
ptDescMode (vll-getInteger cogoPref vll-kPntCreateDescMode)
ptDesc (vll-getString cogoPref vll-kPntCreateDefaultDesc)
lastel (vll-getDouble cogoPref vll-kPntCreateDefaultElev)
) ; setq
(vll-put-autoSave cogoPoints T) ;; make sure autosave of points is on
(if (null *GRADEOBJ:MAX_GAP*)
(setq *GRADEOBJ:MAX_GAP* 25)
) ;_ if
(if (null *GRADEOBJ:OFFD*)
(setq *GRADEOBJ:OFFD* 0)
) ;_ if
(initget (+ 2 4))
(setq *GRADEOBJ:MAX_GAP*
(cond
((getdist
(strcat
"\nMaximum distance between offset points <"
(rtos *GRADEOBJ:MAX_GAP*)
">: "
) ;_ strcat
) ;_ getdist
)
(*GRADEOBJ:MAX_GAP*)
) ;_ cond
*GRADEOBJ:OFFD*
(cond
((getdist
(strcat "\nOffset distance <"
(rtos *GRADEOBJ:OFFD*)
">: "
) ;_ strcat
) ;_ getdist
)
(*GRADEOBJ:OFFD*)
) ;_ cond
lastel
(cond
((getreal
(strcat "\nStart elevation <"
(rtos lastel)
">: "
) ;_ strcat
) ;_ getreal
)
(lastel)
) ;_ cond
) ;setq
(vll-setDouble cogoPref vll-kPntCreateDefaultElev lastel)
(while (setq e (entsel "\nSelect entity: "))
(setq startel lastel
endel "Start")
(while (= (type endel) 'STR)
(initget "Start")
(setq lastel (cond
((getreal
(strcat
"\nEnd elevation (or new Start elevation) <"
(rtos lastel)
">: "
) ;_ strcat
) ;_ getreal
)
(lastel)
) ;_ cond
endel lastel
) ;setq
(vll-setDouble cogoPref vll-kPntCreateDefaultElev lastel)
) ;while not start
(GRADEOBJ:gradeEntity e startel endel)
) ;while select entity
(vlax-release-object cogoPref)
(vlax-release-object cogoPoints)
(vlax-release-object aeccProj)
(vlax-release-object aeccApp)
(vlax-release-object acadObj)
(princ)
) ;_ defun