;; offsettable by ymg November 2015 ;
;; Modified by Igal Averbuh 2015 (Added two digits accuracy for X and Y coordinates, Easting and Northing changed to X and Y) ;
;; Prompts the user to select a polyline reppresenting an alignment, ;
;; User then supply an ofsset to the left and right of the alignment, ;
;; as well as an interval (station) to generate coordinates. ;
;; ;
;; Program proceed to generate a table of stations and coordinates on ;
;; the Left Offset, Center Line and Right Offset ;
;; ;
;; Requires LM:addtable by Lee Mac ;
;; ;

(defun c:ot () (c:offsettable))
(defun c:offsettable (/ *acdoc* *acspc* a an data dif en hgt intv offl offr pc pins pl pr stn tben titl tobj varl x
*error* offsetlist angleatpoint in_range rtosta LM:addtable)

(vl-load-com)

(or *acdoc* (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object))))

(setq *acspc* (if (= (getvar "CVPORT") 1)
(vla-get-PaperSpace *acdoc*)
(vla-get-ModelSpace *acdoc*)
)
)

(defun *error* (msg)
(mapcar 'eval varl)
(if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")))
(princ (strcat "\nError: " msg))
)
(vla-endundomark *acdoc*)
(princ)
)

(defun offsetlist (en offl offr intv / a an dlst dtot ent pc pl pr)
(setq ent (entget en)
dtot (vlax-curve-getDistAtPoint en (vlax-curve-getendpoint en))
dlst (append
(in_range 0 dtot intv)
(list dtot)
)
)
(mapcar '(lambda (a) (setq pc (vlax-curve-getPointAtDist en a)
an (angleatpoint en pc)
pl (polar pc (+ an (/ pi 2)) offl)
pr (polar pc (- an (/ pi 2)) offr)
)
(list
(rtosta a 2 3)
(rtos (car pl) 2 2) (rtos (cadr pl) 2 2)
(rtos (car pc) 2 2) (rtos (cadr pc) 2 2)
(rtos (car pr) 2 2) (rtos (cadr pr) 2 2)
)
)
dlst
)
)

;; ;
;; Return angle along curve, at specified point (on curve) ;
;; e - valid curve (ENAME or VLA-OBJECT) ;
;; p - point on curve ;
;; Alan J. Thompson, 11.04.10 ;
;; ;

(defun AngleAtPoint (e p)
(angle '(0. 0. 0.) (vlax-curve-getFirstDeriv e (vlax-curve-getParamAtPoint e p)))
)

;; ;
;; in_range by ElpanovEvgeniy (recursive) ;
;; ;
;; Similar to the Python Function ;
;; ;

(defun in_range (s e i)
(if (or (and (> i 0) (< s e)) (and ( s e)))
(cons s (in_range (+ i s) e i))
)
)

;; ;
;; rtosta by ymg September 2013 ;
;; ;
;; Arguments: sta, Real number to format as a Station ;
;; unit, 1 for Imperials, ;
;; 2 for Metrics. ;
;; prec, Integer for number of decimals ;
;; DIMZIN must be set to 0 or 1 outside this routine. ;
;; ;
;; Examples: (rtosta 0 1 0) -> "0+00" (rtosta 1328.325 1 2) -> "13+28.33" ;
;; (rtosta 0 2 0) -> "0+000" (rtosta 1328.325 2 2) -> "1+328.33" ;
;; ;
;; If sta is negative, format is as follow: ;
;; (rtosta -1328.325 1 2) -> "13-28.33" ;
;; (rtosta -1328.325 2 2) -> "1-328.33" ;
;; ;

(defun rtosta (sta unit prec / str a b dz)
(setq str (rtos (abs sta) 2 prec))
(while (vla-object
(cdr
(assoc -1
(dictsearch
(cdr
(assoc -1
(dictsearch (namedobjdict) "acad_tablestyle")
)
)
(getvar 'ctablestyle)
)
)
)
)
)
(setq hgt (vla-gettextheight sty acdatarow))
(if (LM:Annotative-p (setq stn (vla-gettextstyle sty acdatarow)))
(setq hgt (/ hgt (getvar 'cannoscalevalue)))
)
(setq wid
(mapcar
(function
(lambda ( col )
(apply 'max
(mapcar
(function
(lambda ( str )
( (lambda ( box ) (if box (+ (* 2.5 hgt) (- (caadr box) (caar box))) 0.0))
(textbox
(list
(cons 01 str)
(cons 40 hgt)
(cons 07 stn)
)
)
)
)
)
col
)
)
)
)
(apply 'mapcar (cons 'list lst))
)
)
(if
(and ttl
(lst ( str del / pos )
(if (setq pos (vl-string-search del str))
(cons (substr str 1 pos) (LM:str->lst (substr str (+ pos 1 (strlen del))) del))
(list str)
)
)

;;---------------------------- Main Routine -------------------------------;

(setq en (car (entsel "\nSelect the Alignment: "))
offl (getdist "\n Enter or Pick Left Offset Distance: ")
offr (getdist "\n Enter or Pick Right Offset Distance: ")
intv (getdist "\n Enter or Pick Interval Distance: ")
titl (strcat " LEFT = " (rtos offl 2 1) " CENTER LINE " " RIGHT = " (rtos offr 2 1))
data (append
(list '("CHAINAGE" "X=" "Y=" "X=" "Y=" "X=" "Y="))
(offsetlist en offl offr intv)
)
pins (cadr (grread nil 13 0))
tobj (LM:addtable *acspc* pins titl data t)
tben (vlax-vla-object->ename tobj)
)
(vl-cmdf "_MOVE" tben "" pins pause)
(*error* nil)
)

(princ "OffsetTable.lsp Loaded!....Type ot or offsettable to run.")
(princ)
(C:OT)

Advertisements