Here's a simple routine that will datum-adjust existing points based on the centerline FG profile of the current alignment. It's useful if you have existing points you want to change the elevation of, or if you don't want/need to go to the overhead of creating a cross-section template and setting points that way.
It will calc the grade for the point based on the profile, then applies two additional datum adjustments: a flat datum adjustment, and another calculated by multiplying a grade percentage you specify by the offset distance of the point from the alignment. (Set these to 0 for no adjustment.)
It could use some improvements, for example: a dialogue box that pops up and asks you to select a FG profile (currently it always uses the centerline one, although you can change this in the code easily enough).
; pt2align.lsp v1.00
; Datum-adjust selected cogo points to the current FG profile.
; Can also apply another flat datum adjustment to profile grade,
; as well as an additional datum adjustment calculated from a grade
; percentage multiplied by the point's offset distance from the alignment.
; Richard Sincovec AUG-21-2004
(vl-load-com)
(if (null vll-kCurve)
(vlax-import-type-library
:tlb-filename "landauto.tlb"
:methods-prefix "vll-"
:properties-prefix "vll-"
:constants-prefix "vll-"
) ;_ vlax-import-type-library
) ;_ if
(defun c:pt2align (/ acadObj aeccApp aeccProj
cogoPoints alignments curAlign ss
pt pt_num curAlignName
err fgProfiles sta ofs
dir elev
)
(if (null *ZYZ_DATUMADJ*)
(setq *ZYZ_DATUMADJ* 0.0)
) ;_ if
(setq *ZYZ_DATUMADJ*
(cond
((getreal
(strcat
"\nDatum adjustment to apply <"
(rtos *ZYZ_DATUMADJ*)
">: "
) ;_ strcat
) ;_ getdist
)
(*ZYZ_DATUMADJ*)
) ;_ cond
) ;_ setq
(if (null *ZYZ_GRADEADJ*)
(setq *ZYZ_GRADEADJ* 0.0)
) ;_ if
(setq *ZYZ_GRADEADJ*
(cond
((getreal
(strcat
"\nGrade adjustment to apply <"
(rtos *ZYZ_GRADEADJ*)
"%>: "
) ;_ strcat
) ;_ getdist
)
(*ZYZ_GRADEADJ*)
) ;_ cond
) ;_ setq
; should probably add more elaborate error detection...
(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)
cogoPoints (vll-get-cogoPoints aeccProj)
alignments (vll-get-alignments aeccProj)
curAlignName (vll-get-currentAlignment alignments)
curAlign (vll-item alignments curAlignName)
fgProfiles (vll-get-fgProfiles curAlign)
profile (vll-profileByType fgProfiles vll-kFgCenter)
ss (ssget '((0 . "AECC_POINT")))
) ;_ setq
(if ss
(progn
(setq count (sslength ss)
index -1
) ;_ setq
(vll-put-autoSave cogoPoints T)
;; make sure autoSave is on
(while (< (setq index (1+ index)) count)
(setq pt_num (cdr
(assoc 90 (entget (ssname ss index)))
) ;_ cdr
pt (vll-pointByNumber cogoPoints pt_num)
) ;_ setq
(setq err2 (vl-catch-all-apply
(function
(lambda ()
(vll-stationOffset
curAlign
(vll-get-easting pt)
(vll-get-northing pt)
'sta
'ofs
'dir
) ;_ vll-stationOffset
) ;_ lambda
) ;_ function
) ;_ vl-catch-all-apply
) ;_ setq
(if err2
(princ (strcat "\nPoint "
(itoa pt_num)
" is not adjacent to alignment."
) ;_ strcat
) ;_ princ
(progn
(setq elev (vll-elevationAt
profile
sta
) ;_ vll-elevationAt
elev (+ elev *ZYZ_DATUMADJ*)
elev (+ elev (* (/ *ZYZ_GRADEADJ* 100) (abs ofs)))
) ;_ setq
(vll-put-elevation
pt
elev
) ;_ vll-put-elevation
(vlax-release-object pt)
) ;_ progn
) ;_ if
) ;_ while
) ;_ progn
) ;_ if
) ;_ lambda
) ;_ function
) ;_ vl-catch-all-apply
) ;_ setq
(if (vl-catch-all-error-p err)
(princ (strcat "\nError: "
(vl-catch-all-error-message err)
"\nMake sure current alignment is selected, and alignment has a center FG profile."
) ;_ strcat
) ;_ princ
) ;_ if
(if profile (vlax-release-object profile))
(if fgProfiles (vlax-release-object fgProfiles))
(if curAlign (vlax-release-object curAlign))
(if alignments (vlax-release-object alignments))
(if cogoPoints (vlax-release-object cogoPoints))
(if aeccProj (vlax-release-object aeccProj))
(if aeccApp (vlax-release-object aeccApp))
(princ)
) ;_ defun
