coordinates of centerline and both side offsets

[ymg3]

anindya,

 

Here's a canned solution, uses routine LM:addtable by Lee Mac to fill the table

with the data produce by my part of it.

 

;; offsettable    by ymg           November 2015                             ;
;;                                                                            ;
;; 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 3) (rtos (cadr pl) 2 3) 
                             (rtos (car pc) 2 3) (rtos (cadr pc) 2 3)
                             (rtos (car pr) 2 3) (rtos (cadr pr) 2 3)
                          )
              )              
              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 (< i 0) (> 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 (< (strlen str) (if (= prec 0) (+ unit 2) (+ prec (+ unit 3))))
        (setq str (strcat "0" str))
     )
     (setq a (if (= prec 0) (- (strlen str) unit) (- (strlen str) prec (+ unit 1)))
           b (substr str 1 (- a 1))
           a (substr str a)
     )
     (strcat b (if (minusp sta) "-" "+") a)
  )

  ;;---------------------------=={ Add Table }==----------------------------;;
  ;;                                                                        ;;
  ;;  Creates an AutoCAD Table Object at the specified point,               ;;
  ;;  populated with the given data and optional title.                     ;;
  ;;------------------------------------------------------------------------;;
  ;; Author:  Lee Mac, Copyright © 2013  -  www.lee-mac.com                 ;;
  ;;------------------------------------------------------------------------;;
  ;;  Arguments:                                                            ;;
  ;;  spc - VLA Block Object                                                ;;
  ;;  ins - WCS Insertion Point for Table                                   ;;
  ;;  ttl - [Optional] Table title                                          ;;
  ;;  lst - Matrix list of data to populate the table                       ;;
  ;;  eqc - If T, columns are of equal width                                ;;
  ;;------------------------------------------------------------------------;;
  ;;  Returns:  VLA Table Object                                            ;;
  ;;------------------------------------------------------------------------;;
   
  (defun LM:AddTable ( spc ins ttl lst eqc / dif hgt i j obj stn sty wid )
      (setq sty
          (vlax-ename->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
              (< 0.0
                  (setq dif
                      (/
                          (-
                              (   (lambda ( box ) (if box (+ (* 2.5 hgt) (- (caadr box) (caar box))) 0.0))
                                  (textbox
                                      (list
                                          (cons 01 ttl)
                                          (cons 40 hgt)
                                          (cons 07 stn)
                                      )
                                  )
                              )
                              (apply '+ wid)
                          )
                          (length wid)
                      )
                  )
              )
          )
          (setq wid (mapcar '(lambda ( x ) (+ x dif)) wid))
      )
      (setq obj
          (vla-addtable spc
              (vlax-3D-point ins)
              (1+ (length lst))
              (length (car lst))
              (* 2.0 hgt)
              (if eqc
                  (apply 'max wid)
                  (/ (apply '+ wid) (float (length (car lst))))
              )
          )
      )
      (vla-put-regeneratetablesuppressed obj :vlax-true)
      (vla-put-stylename obj (getvar 'ctablestyle))
      (setq i -1)
      (if (null eqc)
          (foreach col wid
              (vla-setcolumnwidth obj (setq i (1+ i)) col)
          )
      )
      (if ttl
          (progn
              (vla-settext obj 0 0 ttl)  
              (setq i 1)
          )
          (progn
              (vla-deleterows obj 0 1)
              (setq i 0)
          )
      )
      (foreach row lst
          (setq j 0)
          (foreach val row
              (vla-settext obj i j val)
              (setq j (1+ j))
          )
          (setq i (1+ i))
      )
      (vla-put-regeneratetablesuppressed obj :vlax-false)
      obj
  )
   
  ;; Annotative-p                                                            ;
  ;; Returns T if the given Textstyle is annotative                          ;
   
  (defun LM:annotative-p ( sty )
      (and (setq sty (tblobjname "style" sty))
           (setq sty (cadr (assoc -3 (entget sty '("AcadAnnotative")))))
           (= 1 (cdr (assoc 1070 (reverse sty))))
      )
  )
   
  ;; String to List                                                          ;
  ;; Separates a string using a given delimiter                              ;
  ;; str - [str] string to process                                           ;
  ;; del - [str] delimiter by which to separate the string                   ;
   
  (defun LM:str->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" "EASTING" "NORTHING" "EASTING" "NORTHING" "EASTING" "NORTHING"))
                 (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)            

Offset Table.LSP

[anindya]

ymg3 sir what can i say to u,,,,,,,,,,only one thing "EXCELLENT"

[sanju2323]

Hi ymg,

Please you can add columns of elevation.

[ymg3]

sanju,

 

Adding column of elevation is No big deal, however your polyline should be 3dpoly in order

to get meaningful results.

 

Plus as it is, we are not calculating any slope to the offset line, so your elevation will

be the same at all 3 points on a given chainage.

 

ymg

Edited December 19, 2015 by ymg3

[sanju2323]

ymg,

 

I'm using it to get the list of crossing and it is necessary to get the results from the DTM model.

 

sanju

Sample.dwg

[sanju2323]

ymg,

 

can you make crossing report.

 

sanju.

Report of Crossings.csv

[trazos]

hola, soy nuevo en el foro les doy estoy agradecidos por la información que consegui en ta comunidad ya logre entender como se cambia la extensión de un archivo de texto para guardarlo como rutina lisp., gracias saludos!!