Before I tackled .Net and when first diving into Civil3d I was desperate to access objects using lisp. Just some of the remnants of the past, and likely lots of rookie mistakes, but they did the job
;;;;Streams surface elevations in the command line
(defun c:SEI ()
(vl-load-com)
(setq obj (vlax-ename->vla-object (car (entsel "\nSurface:"))))
(while
(setq pt (cadr (grread t)))
(setq pt (trans pt 0 1))
(print
(vlax-invoke obj 'FindElevationAtXY (car pt) (cadr pt))
)
(princ)
)
)
;;;add elevation tags along a feature line...use with a block that has two attributes...one for elevation...another for description
(defun c:flt ()
(command "undo" "begin")
(setq mydwgscale (getvar "dimscale"))
(setq suffix (getstring "\nSuffix?"))
(print "Select Featureline:")
(setq featureobj (vlax-ename->vla-object (car (entsel))))
(while (= 0 0)
(setq location (getpoint "\nPoint Along Feature Line:"))
(setq location (vlax-curve-getClosestPointToProjection featureobj location '(0 0 1)))
(setq param (vlax-curve-getParamAtPoint featureobj location))
(setq pointdata (vlax-curve-getPointAtParam featureobj param))
(setq xpt (car pointdata))
(setq ypt (cadr pointdata))
(setq xy (list xpt ypt))
(setq elev (caddr pointdata))
(setq elev (rtos elev 2 2))
(command "-insert" "ELV-TAG DYN" xy 30 "45.0" elev suffix)
)
(command "undo" "end")
(princ));;;
;;;used to draw polylines in a profile view using stations and elevations
(defun c:pstal ()
(princ "\nPress Return to draw line")
(setq ptlist nil)
(vl-load-com)
(command "-layer" "n" "B-CONST" "S" "B-CONST" "C" "140" "" "")
(setq ent (entsel "\nSelect profile view:"))
(while
(setq sta (getreal "\nStation:"))
(setq elev (getreal "\nElevation:"))
(setq obj (vlax-ename->vla-object (car ent)))
(vlax-invoke-method obj 'FindXYAtStationAndElevation sta elev 'x 'y)
(setq pnt (list x y))
(setq ptlist (append ptlist (list pnt)))
)
(setq ptlen (length ptlist))
(if (= ptlen 1)
(command "line" pnt)
(progn
(command "line")(foreach pnt ptlist (command pnt))(command nil)
)
)
(princ));;;;
;;;;;use with a block with 2 attributes... your finish grade profile should be named exactly the same as your alignment with "-CL-FG" at the end. It inserts the block and places the elevation and station
;;;adds sta and elevation label to profile view
(defun c:pstl ()
(vl-load-com)
(command "undo" "begin")
(command "-layer" "n" "C-PROF-T" "S" "C-PROF-T" "C" "GREEN" "" "")
(setq ent (entsel "\nSelect profile view:"))
(while (= 0 0)
(setq obj (vlax-ename->vla-object (car ent)))
(setq proparent (vlax-get-property obj 'parent))
(setq nam (vlax-get-property proparent 'Name))
(setq pro (vlax-get-property proparent 'profiles))
(vlax-put (vlax-invoke-method pro 'item 0) 'name (strcat nam "-CL-FG"))
(setq pro (vlax-get-property proparent 'profiles))
(setq pronam (vlax-invoke-method pro 'item (strcat nam "-CL-FG")))
(setq propvi (vlax-get-property pronam 'pvis))
(setq pnt (getpoint "\nPoint to Label:"))
(setq xpnt (car pnt))
(setq ypnt (cadr pnt))
(setq staoff (vlax-invoke-method obj 'FindStationAndElevationAtXY xpnt ypnt 'sta 'elev))
;;;covert to station;;;
(setq stat (rtos sta 2 2))
(setq stal (- (strlen stat) 1))
(if (= stal 6)
(progn
(setq lta (substr stat 1 2))
(setq ltb (substr stat 3 6))
(setq sta (strcat lta "+" ltb))
) ;end progn
;else
(if (= stal 5)
(progn
(setq lta (substr stat 1 1))
(setq ltb (substr stat 2 5))
(setq sta (strcat lta "+" ltb))
) ;end progn
;else
(if (= stal 4)
(progn
(setq lta (substr stat 1 1))
(setq ltb (substr stat 2 4))
(setq sta (strcat "00+" lta ltb))
) ;end progn
;else
(if (= stal 3)
(progn
(setq lta (substr stat 1 1))
(setq ltb (substr stat 2 3))
(setq sta (strcat "00+0" lta ltb))
)
)
)
)
)
;;;end conversion;;;;
(setq elev (rtos elev 2 2))
(command "-insert" "PROF-NOTE" pnt "40.0" "" "45.0" (strcat "STA.=" sta)(strcat "INV.=" elev)"")
)
(command "undo" "end")
(princ));;;;
;;;;adds pvi to profile view...profiles need to have exact name of alignment with "-CL-FG" at the end;;;;
(defun c:apvi ()
(vl-load-com)
(command "undo" "begin")
(setq ent (entsel "\nSelect profile view:"))
(while (= 0 0)
(setq obj (vlax-ename->vla-object (car ent)))
(setq proparent (vlax-get-property obj 'parent))
(setq nam (vlax-get-property proparent 'Name))
(setq pro (vlax-get-property proparent 'profiles))
(setq pronam (vlax-invoke-method pro 'item (strcat nam "-CL-FG")))
(setq propvi (vlax-get-property pronam 'pvis))
(setq pnt (getpoint "\nAdd PVI:"))
(setq xpnt (car pnt))
(setq ypnt (cadr pnt))
(setq staoff (vlax-invoke-method obj 'FindStationAndElevationAtXY xpnt ypnt 'sta 'elev))
(vlax-invoke-method propvi 'add sta elev 1)
(setq pviat (vlax-invoke-method propvi 'itemat sta elev))
(setq pviin (vlax-get-property pviat 'gradein))
(setq pvigout (vlax-get-property pviat 'gradeout))
)
(command "undo" "end")
(princ));;;;
;;;;delete pvi from profile view...profiles need to have exact name of alignment with "-CL-FG" at the end;;;
(defun c:dpvi ()
(command "undo" "begin")
(setq ent (entsel "\nSelect profile view:"))
(while (= 0 0)
(setq obj (vlax-ename->vla-object (car ent)))
(setq proparent (vlax-get-property obj 'parent))
(setq nam (vlax-get-property proparent 'Name))
(setq pro (vlax-get-property proparent 'profiles))
(setq pronam (vlax-invoke-method pro 'item (strcat nam "-CL-FG")))
(setq propvi (vlax-get-property pronam 'pvis))
(setq pnt (getpoint "\nDelete PVI:"))
(setq xpnt (car pnt))
(setq ypnt (cadr pnt))
(setq staoff (vlax-invoke-method obj 'FindStationAndElevationAtXY xpnt ypnt 'sta 'elev))
(vlax-invoke-method propvi 'RemoveAt sta elev)
)
(command "undo" "end")
(princ));;;;
;;;;fgpoly creates multi-3dpoly at profile alignment....profile needs to be named exactly like alignment with "-CL-FG" at the end
(defun c:fgpm ()
(command "undo" "begin")
(setq ptlist nil)
(vl-load-com)
(setq adj (getreal "\nChange in Elevation:"))
(setq sel (entsel "\nSelect Alignment: "))
(setq inc 1)
(setq ent (car sel))
(setq obj (vlax-ename->vla-object ent))
(setq end (vlax-get obj 'EndingStation))
(setq nam (vlax-get-property obj 'Name))
(setq pro (vlax-get-property obj 'profiles))
(setq pronam (vlax-invoke-method pro 'item (strcat nam "-CL-FG")))
(setq pviobj (vlax-get pronam 'pvis))
(setq countpvis (vlax-get-property pviobj 'count))
(setq lastpvis (- countpvis 1))
(setq firstpvi (vlax-invoke pviobj 'item 0))
(setq lastpvi (vlax-invoke pviobj 'item lastpvis))
(setq stapvi (vlax-get firstpvi 'Station))
(setq endpvi (vlax-get lastpvi 'Station))
(setq sta (+ stapvi 1.0))
(while (< sta endpvi)
(vlax-invoke-method obj 'PointLocation sta 0 'east 'north)
(vlax-invoke-method obj 'StationOffset east north 'sta 'off)
(setq elev (vlax-invoke-method pronam "ElevationAt" sta))
(setq datum (+ elev adj))
(setq elevfnl (atof (rtos datum 2 2)))
(setq points (list (atof (rtos east 2 2)) (atof (rtos north 2 2)) elevfnl))
(setq ptlist (append ptlist (list points)))
(vlax-invoke-method obj 'PointLocation sta 17 'east 'north)
(vlax-invoke-method obj 'StationOffset east north 'sta 'off)
(setq elevr (vlax-invoke-method pronam "ElevationAt" sta))
(setq datumr (+ elev adj))
(setq datumr (- datumr 0.34))
(setq elevfnlr (atof (rtos datumr 2 2)))
(setq pointsr (list (atof (rtos east 2 2)) (atof (rtos north 2 2)) elevfnlr))
(setq ptlistr (append ptlistr (list pointsr)))
(vlax-invoke-method obj 'PointLocation sta -17 'east 'north)
(vlax-invoke-method obj 'StationOffset east north 'sta 'off)
(setq elevl (vlax-invoke-method pronam "ElevationAt" sta))
(setq datuml (+ elev adj))
(setq datuml (- datuml 0.34))
(setq elevfnll (atof (rtos datuml 2 2)))
(setq pointsl (list (atof (rtos east 2 2)) (atof (rtos north 2 2)) elevfnll))
(setq ptlistl (append ptlistl (list pointsl)))s
(setq sta (+ sta inc))
)
(command "3dpoly")(foreach points ptlist (command points)"")(command nil)
(command "3dpoly")(foreach pointsr ptlistr (command pointsr)"")(command nil)
(command "3dpoly")(foreach pointsl ptlistl (command pointsl)"")(command nil)
(command "undo" "end")
(princ));;;;
;;;draw line on alignment by station;;;
(defun c:stal ()
(command "undo" "begin")
(vl-load-com)
(setq sel (entsel "\nSelect Alignment: "))
(while (= 0 0)
(setq sta (getreal "\nStation: "))
(setq ent (car sel))
(setq lst (entget ent))
(setq obj (vlax-ename->vla-object ent))
(vlax-invoke-method obj 'PointLocation sta -100 'east 'north)
(setq start (strcat (rtos east 2 2) "," (rtos north 2 2)))
(vlax-invoke-method obj 'PointLocation sta 100 'east 'north)
(setq end (strcat (rtos east 2 2) "," (rtos north 2 2)))
(command "line" start end "")
)
(command "undo" "end")
(princ));;;;
;;;label station and offset;;;
(defun c:stl ()
(command "undo" "begin")
(vl-load-com)
(setq lst nil)
(setq sel (entsel "\nSelect Alignment: "))
(while T
(setq pt1 (getpoint "\nPoint: "))
(setq rtpoint pt1)
(setq ent (car sel))
(setq lst (entget ent))
(setq obj (vlax-ename->vla-object ent))
(setq nam (vlax-get-property obj 'Name))
(setq sta1 (vlax-get-property obj 'StartingStation))
(setq sta2 (vlax-get-property obj 'EndingStation))
(vlax-invoke-method obj 'StationOffset (car pt1) (cadr pt1) 'sta 'off)
(setq sta (rtos sta 2 2))
(setq off (rtos off 2 2))
;;;convert to station format;;;;
(setq sta2 (atof sta))
(setq x sta2)
(setq n 2)
(setq pref (fix (/ x 100.00)))
(setq suff (rtos (- x (* 100 pref)) 2 n))
(setq fnl (strcat (itoa pref) "+" suff))
;;;add left or right to offset;;;
(setq off2 (atof off))
(if (< off2 0)(setq side "' LT.")(setq side "' RT."))
(setq off (atof off))
(setq off (abs off))
(setq off (rtos off 2 2))
(setq off (strcat off side))
(command "text" pt1 "" FNL)
(setq ent1 (entlast))
(command "text" "" off)
(setq ent2 (entlast))
(command "rotate" ent1 ent2 "" rtpoint pause)
);end while
(command "undo" "end")
(princ));;;
