Was wonder how hard it would be to create something which you would automatically calc a elevation on a given point by 2 point elevations.
Answer: not easy ...at least the way I did it.
This took a bit of work.
This builds on the previous routine I posted. It sprays in equally-spaced points at a user-specified offset from any entity. This version allows you to enter grade-breaks along the entities. It also works on polylines, so that points are spaced equally along each segment of the polyline, all verteces have offset points, and two offset points are set at vertices with a significant angle point between the course in and the course out.
Best used for, say, a parking lot, where you're staking offsets to top-back of curb, your TBC is drawn as a giant polyline, and you have spot elevations at all gradebreaks.
First enter the maximum distance between offsets and the offset distance (positive is right side, negative for left, 0 is no offset). Type your start elevation, then select the polyline near the end you want to start on. You can then enter the end elevation, and points will spray in along the entire length of the entity, or you can select grade breaks along the entity, and points will spray in on each segment as you go. When picking a grade break, the routine automatically performs a "snap to perpendicular"-style calculation, so you don't have to pick a point right on the object. For example, if a grade break is labeled by a leader pointing to a spot in the middle of the pan, you can select the end of the leader. The routine will calculate the grade break as being at the closest point on the TBC entity to the point you select.
WARNING: this routine has not been extensively tested. Let me know of problems/ideas. Here's some of my ideas for improvements:
1. Fix the out-of-order problem that happens to points at verteces of polylines if you're setting points "backwards" on the polyline (i.e., if you start closest to the point returned by calling vlax-curve-getEndPoint on the polyline).
2. For polylines with angle points, step through each angle point and ask the user if this point should have two offsets, one for course in and one for course out, or one offset, at the point where the vertex would be if the whole polyline were offset the offset distance. Possibly zoom the screen to the vertex in question, do something like use the markPoint routine to draw bright cyan Xs at the points where the two offsets would be, and a single bright pink X at the point where the single offset would be, and ask the user to pick 1 or 2...
3. Allow the setting of a "minimum radius" value, so that arcs or arced polyline-segments that have a radius smaller than a certain value only get the radius point set.
4. Allow the setting of a "maximum radius" value, which causes the radius point of any arc or arced polyline-segment to be automatically set if the radius is smaller than the specified value (in addition to any other points that are set).[/list:u]
; pgrd.lsp v1.00
; 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. Allows the user to
; specify grade breaks along the course of the entity, and works on
; polylines.
; Richard Sincovec 8/15/2004
(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 *PGRD:QUAD* (/ PI 2)) ; radians in a quadrant
(setq *PGRD:FUZZ* 0.00001) ; fuzz factor
(setq *PGRD:MARK_FACTOR* 40) ; bigger number = smaller mark; 1 = full screen
; This value is minimum seperation between offsets at polyline verteces.
; If offset from course in and offset from course out are within this
; distance of each other, only one point will be set.
(setq *PGRD:TOLERANCE* 0.2)
(defun PGRD: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 *PGRD:FUZZ*) (vlax-curve-getStartPoint entName))
((equal dist d *PGRD:FUZZ*) (vlax-curve-getEndPoint entName))
) ;_ cond
)
) ;_ cond
) ;_ defun
; draws an x at the specified point
(defun PGRD:markPoint (pnt / markSize)
(setq markSize (/ (/ (getvar "viewsize") *PGRD:MARK_FACTOR*) 2))
(grvecs
(list
7
(list (- (car pnt) markSize) (- (cadr pnt) markSize))
(list (+ (car pnt) markSize) (+ (cadr pnt) markSize))
(list (- (car pnt) markSize) (+ (cadr pnt) markSize))
(list (+ (car pnt) markSize) (- (cadr pnt) markSize))
) ;_ list
) ;_ grvecs
) ;_ defun
(defun PGRD:setPoint (coords elev / pnt d)
(setq
pnt (vll-add
cogoPoints
(vlax-3D-point (list (car coords) (cadr coords) 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 PGRD:azimuthAtParam (entity selPar / dvec)
(setq dvec (vlax-curve-getFirstDeriv entity selPar))
(angle '(0 0) dvec)
;; note: angle projected on xy plane
) ;defun PGRD:azimuthAtParam
; value of dir: -1 = clockwise, 1 = counterclockwise
(defun PGRD:offsetAtPoint (entity point dir offDist)
(if (= offDist 0)
point
(polar
point
(+ (* dir *PGRD:QUAD*)
(PGRD:azimuthAtParam
entity
(vlax-curve-getParamAtPoint entity point)
) ;_ PGRD:azimuthAtParam
) ;_ +
offDist
) ;_ polar
) ;if
) ;defun PGRD:offsetAtPoint
(defun PGRD:offsetAtParam (entity param dir offDist)
(if (= offDist 0)
(vlax-curve-getPointAtParam entity param)
(polar
(vlax-curve-getPointAtParam entity param)
(+ (* dir *PGRD:QUAD*) (PGRD:azimuthAtParam entity param))
offDist
) ;_ polar
) ;if
) ;_ defun
(defun PGRD:gradeSegment (entName curDist segEnd offDir
startel endel setEndF /
segLen numSegs deltaPos deltaz
curz
)
(setq segLen (abs (- segEnd curDist))
numSegs (1+ (fix (/ segLen *PGRD:MAX_GAP*)))
) ;_ setq
(if (= (rem segLen *PGRD:MAX_GAP*) 0)
(setq numSegs (1- numSegs))
) ;_ if
(setq deltaPos (/ (- segEnd curDist) numSegs)
deltaz (/ (- endel startel) numSegs)
curz startel
) ;_ setq
(repeat numSegs
(PGRD:setPoint
(PGRD:offsetAtPoint
entName
(PGRD:getPointAtDist entName curDist)
offDir
*PGRD:OFFD*
) ;_ PGRD:offsetAtPoint
curz
) ;_ PGRD:setPoint
(setq curDist (+ curDist deltaPos)
curz (+ curz deltaz)
) ;_ setq
) ;repeat
(if setEndF
(PGRD:setPoint
(PGRD:offsetAtPoint
entName
(PGRD:getPointAtDist entName curDist)
offDir
*PGRD:OFFD*
) ;_ PGRD:offsetAtPoint
endel
) ;_ PGRD:setPoint
) ;_ if
) ;_ defun
(defun C:pgrd
(/ e startel endel acadObj
aeccApp aeccProj aeccPref cogoPoints cogoPref
ptDescMode ptDesc entName entType isPolyline
lastel selPoint endPar tLen selLen
offDir ang inp setEndF segEnd
entStart entEnd segEndPt startPar parList
grade pieces i endF off1
off2 param param2 pieceEndEl pieceStartEl
err
)
(setq err
(vl-catch-all-apply
(function
(lambda ()
(setq acadObj (vlax-get-acad-object)
aeccApp (vla-getInterfaceObject
acadObj
"Aecc.Application"
) ;_ vla-getInterfaceObject
aeccProj (vll-get-activeProject aeccApp)
aeccPref (vll-get-preferences aeccProj)
cogoPref (vll-get-cogo aeccPref)
cogoPoints (vll-get-cogoPoints aeccProj)
ptDescMode (vll-getInteger
cogoPref
vll-kPntCreateDescMode
) ;_ vll-getInteger
ptDesc (vll-getString
cogoPref
vll-kPntCreateDefaultDesc
) ;_ vll-getString
lastel (vll-getDouble
cogoPref
vll-kPntCreateDefaultElev
) ;_ vll-getDouble
) ; setq
(if (null *PGRD:MAX_GAP*)
(setq *PGRD:MAX_GAP* 25.0)
) ;_ if
(if (null *PGRD:OFFD*)
(setq *PGRD:OFFD* 0.0)
) ;_ if
(if (null lastel)
(setq lastel 0.0)
) ;_ if
(initget (+ 2 4))
(setq *PGRD:MAX_GAP*
(cond
((getdist
(strcat
"\nMaximum distance between offset points <"
(rtos *PGRD:MAX_GAP*)
">: "
) ;_ strcat
) ;_ getdist
)
(*PGRD:MAX_GAP*)
) ;_ cond
*PGRD:OFFD*
(cond
((getdist
(strcat "\nOffset distance <"
(rtos *PGRD:OFFD*)
">: "
) ;_ strcat
) ;_ getdist
)
(*PGRD:OFFD*)
) ;_ cond
lastel
(cond
((getreal
(strcat "\nStart elevation <"
(rtos lastel)
">: "
) ;_ strcat
) ;_ getreal
)
(lastel)
) ;_ cond
) ;setq
(vll-setDouble cogoPref vll-kPntCreateDefaultElev lastel)
;; make sure point autoSave is on
(vll-put-autoSave cogoPoints T)
(while (setq e (entsel "\nSelect entity: "))
(setq entName (car e)
entType (cdr (assoc 0 (entget entName)))
isPolyline (or (= entType "LWPOLYLINE")
(= entType "POLYLINE")
) ;_ or
endel nil
selPoint (vlax-curve-getClosestPointTo
entName
(cadr e)
) ;_ vlax-curve-getClosestPointTo
endPar (vlax-curve-getEndParam entName)
tLen (vlax-curve-getDistAtParam entName endPar)
selLen (vlax-curve-getDistAtPoint entName selPoint)
) ;setq
; offDir=-1 when user selected closer to beginning of object
(if (< selLen (/ tLen 2))
(setq offDir -1
curDist 0
entStart 0
entEnd tLen
) ;_ setq
(setq offDir 1
curDist tLen
entStart tLen
entEnd 0
) ;_ setq
) ;if
(while (not (equal curDist entEnd *PGRD:FUZZ*))
(redraw entName 3)
(setq startel lastel
endel nil
segEnd entEnd
) ;_ setq
(while (null endel)
(initget 128 "Start")
(setq inp
(getpoint
(PGRD:getPointAtDist entName curDist)
(strcat
"\nEnter end elevation, new [Start] elevation, "
"or pick grade break <"
(rtos lastel)
">: "
) ;_ strcat
) ;_ getpoint
) ;_ setq
(cond
((null inp) (setq endel lastel))
((= (type inp) 'LIST)
(setq segEndPt (vlax-curve-getClosestPointTo
entName
inp
) ;_ vlax-curve-getClosestPointTo
) ;_ setq
(setq inp (vlax-curve-getDistAtPoint
entName
segEndPt
) ;_ vlax-curve-getDistAtPoint
) ;_ setq
(if (< (* inp offDir) (* curDist offDir))
(progn
(setq segEnd inp)
(PGRD:markPoint segEndPt)
) ;_ progn
(princ
"\nThat point isn't between the last selection and the end!"
) ;_ princ
) ;_ if
) ;_ (= (type inp) 'PT)
((= (type inp) 'STR)
(cond
((setq endel (distof inp))
(setq lastel endel)
)
((= inp "") (setq endel lastel))
((= inp "Start")
(setq lastel
(cond
((getreal
(strcat "\nStart elevation <"
(rtos lastel)
">: "
) ;_ strcat
) ;_ getreal
)
(lastel)
) ;_ cond
startel lastel
) ;_ setq
) ;_ (= inp "Start")
) ;_ cond
) ;_ (= (type inp) 'STR)
) ;_ cond
) ;while null endel
(vll-setDouble
cogoPref
vll-kPntCreateDefaultElev
lastel
) ;_ vll-setDouble
(setq setEndF nil)
(if (setq endF (equal segEnd entEnd *PGRD:FUZZ*))
(progn
(initget "Yes No")
(setq setEndF
(/= (getKword "\nSet end point (Yes/No)? <Yes> ")
"No"
) ;_ =
) ;_ setq
) ;_ progn
) ;_ if
(if isPolyline
; object is a polyline
(progn
(setq startPar (vlax-curve-getParamAtDist
entName
curDist
) ;_ vlax-curve-getParamAtDist
endPar (vlax-curve-getParamAtDist
entName
segEnd
) ;_ vlax-curve-getParamAtDist
grade (/ (- endel startel) (- segEnd curDist))
pieceStartEl startel
parList (list startPar)
) ;_ setq
(if (< startPar endPar)
(progn
(setq param (1+ (fix startPar)))
(while (< param endPar)
(setq parList (append parList (list param))
param (1+ param)
) ;_ setq
) ;_ while
) ;_ progn
(progn
(setq param (fix startPar))
(if (equal param startPar *PGRD:FUZZ*)
(setq param (1- param))
) ;_ if
(while (> param endPar)
(setq parList (append parList (list param))
param (1- param)
) ;_ setq
) ;_ while
) ;_ progn
) ;_ if
(setq parList (append parList (list endPar))
pieces (1- (length parList))
i -1
) ;_ setq
(while (< (setq i (1+ i)) pieces)
(setq
param (nth (1+ i) parList)
startD (vlax-curve-getDistAtParam
entName
(nth i parList)
) ;_ vlax-curve-getDistAtParam
endD (vlax-curve-getDistAtParam
entName
param
) ;_ vlax-curve-getDistAtParam
pieceEndEl (+ pieceStartEl
(* (- endD startD) grade)
) ;_ +
) ;_ setq
(PGRD:gradeSegment
entName
startD
endD
offDir
pieceStartEl
pieceEndEl
(cond
((and endF (= i (1- pieces))) setEndF)
(nil)
) ;_ cond
) ;_ PGRD:gradeSegment
(if (not (= i (1- pieces)))
(progn
; check difference between location of offset on course in and
; course out of vertex; if within tolerance, only set one point
; Note that one offset is actually from a point 0.00001 drawing units before the
; vertex, since direction of polyline at vertex is for the segment after the vertex.
; This is an approximation that may need to be adjusted for drawings that use entities
; that are very small (in terms of drawing units).
(setq
off1 (PGRD:offsetAtParam
entName
(vlax-curve-getParamAtDist
entName
(- endD 0.00001)
) ;_ vlax-curve-getParamAtDist
offDir
*PGRD:OFFD*
) ;_ PGRD:offsetAtParam
off2 (PGRD:offsetAtParam
entName
param
offDir
*PGRD:OFFD*
) ;_ PGRD:offsetAtParam
) ;_ setq
(if
(> (distance off1 off2) *PGRD:TOLERANCE*)
; need two offsets; set one now, the one just off the vertex
; offset on vertex will be set as start point of next segment
(PGRD:setPoint off1 pieceEndEl)
) ;_ if
) ;_ progn
) ;_ if
(setq pieceStartEl pieceEndEl)
) ;_ while
(setq curDist segEnd)
) ;_ progn
; object is not a polyline
(progn
(PGRD:gradeSegment
entName curDist segEnd offDir startel endel
setEndF) ;_ PGRD:gradeSegment
;_ PGRD:gradeSegment
(setq curDist segEnd)
) ;_ progn
) ;_ if
) ;_ while (not (equal curDist entEnd *PGRD:FUZZ*))
(redraw entName 4)
) ;while select entity
) ;_ lambda
) ;_ function
) ;_ vl-catch-all-apply
) ;_ setq
;; Don't really care what the error is; just want to
;; catch it so we can release the vla-objects - Autocad
;; becomes unstable if you don't release certain vla-objects,
;; so release them all just to be safe.
(if (vl-catch-all-error-p err)
(princ (vl-catch-all-error-message err))
) ;_ if
(if cogoPoints (vlax-release-object cogoPoints))
(if cogoPref (vlax-release-object cogoPref))
(if aeccPref (vlax-release-object aeccPref))
(if aeccProj (vlax-release-object aeccProj))
(if aeccApp (vlax-release-object aeccApp))
(if acadObj (vlax-release-object acadObj))
(princ)
) ;_ defun
