Extract 3d polyline station and elevation

Hi , i am trying to extract station and elevetion from 3d polyline to txt file

Important : For the station i need only Horizontal distanse not slope distanse

(i need this file to use it for cross sections)

This is an old code i try to change it but fail !! I attach two export files for example

(defun c:sz (/ ent fh fn hnd itm num obj pnt sset v vexx)
 ;; helper to get 3dpoly coordinates
 (defun 3dpoly-verts  (en / elist  lst vex)

 (if (member "AcDb3dPolyline"
      (mapcar 'cdr (entget en)))
   (progn
     (setq vex (entnext en))
     (setq elist (entget vex))
     (while (= (cdr (assoc 0 elist)) "VERTEX")
(setq lst (cons (trans (cdr (assoc 10 elist)) 1 0) lst))
(setq vex (entnext vex))
(setq elist (entget vex))
)
     )
   )
 (reverse lst)
 )
 
 ;;________________________________________________;;
 
 (setq sset (ssget '((-4 . "<OR")(0 . "POINT")
                     (0 . "POLYLINE")(-4 . "OR>"))))
 (if sset
   (progn
     (setq itm 0 num (sslength sset))
     (setq fn (getfiled "Αποθήκευση αρχείου station,Z" "" "txt" 1))
     (if (/= fn nil)
       (progn
         (setq fh (open fn "w"))
         (while (< itm num)
           (setq hnd (ssname sset itm))
           (setq ent (entget hnd))
           (setq obj (cdr (assoc 0 ent)))
           (cond
             ((eq obj "POINT")
               (setq pnt (cdr (assoc 10 ent)))
               (setq pnt (trans pnt 0 1));;**CAB
               (write-line (strcat (rtos (distance pnt pnt) 2 3) ","    ; i don't know how to give the distanse
                                      (rtos (caddr pnt) 2 3)) fh)

             )
             ((= obj "POLYLINE")
       (setq v hnd)
       (setq vexx (3dpoly-verts v ))
       (foreach pnt vexx
               (write-line (strcat (rtos (distance pnt pnt) 2 3) ","; i don't know how to give the distanse
                              (rtos (caddr pnt) 2 3)) fh)


)	       
)


             (t nil)
           )
           (setq itm (1+ itm))
         )
         (close fh)
       )
     )
   )
 )
 (princ)
)

(princ)

test1(open poly).txt

test1(close poly).txt

test.dwg

If you dont have any curves this will work, you will though have to do the distance bit from the xy of the point just remember pythagoras thereom.

; pline co-ords example
(defun getcoords (ent)
 (vlax-safearray->list
   (vlax-variant-value
     (vlax-get-property
   (vlax-ename->vla-object ent)
   "Coordinates"
     )
   )
 )
)

(defun co-ords2xy ()
; convert now to a list of xy as co-ords are x y x y x y if 3d x y z x y z
(setq numb (/ (length co-ords) 2))
(setq I 0)
(repeat numb
(setq xy (list (nth i co-ords)(nth (+ I 1) co-ords) ))
(setq co-ordsxy (cons xy co-ordsxy))
(setq I (+ I 2))
)
)
; program starts here
(setq co-ords (getcoords (car (entsel "\nplease pick pline"))))
(co-ords2xy) ; list of 2d or 3d points making pline
; list xy is 2d or 3d pts 

Hi , i am trying to extract station and elevetion from 3d polyline to txt file

 

Important : For the station i need only Horizontal distanse not slope distanse

(i need this file to use it for cross sections)

Hi prodromosm,

Just a thought,

I think it's time for you to start trying to write your own codes.

This demo it's just a different approach...

Try to understand the code, it's written in a simple way, and I think it will be easy to understand, if not, just asks...

(defun c:demo (/ e fn fo lst par parpt poly pos pre pt s)
 (prompt "\nSelect a 3DPolyline to extract Stations and Elevations to txt file: ")
 (if
   (and (setq s (ssget "_+.:E:S" '((0 . "POLYLINE") (-4 . "&") (70 . )))
 (setq fn (getfiled "Enter the output filename:" (getvar 'DWGPREFIX) "txt" 1))
 (setq pre (strcase (getstring "\nEnter station prefix:")))
   );; and
    (progn
      (setq poly (vlax-ename->vla-object (ssname s 0))
     e	  (fix (vlax-curve-getEndParam poly))
     pos  0
     par  0
     lst  nil
      );; setq
      (while (/= par (1+ e))
 (setq pt  (vlax-curve-getPointAtParam poly par)
       pos (1+ pos)
 );; setq
 (if (not parpt)
   (setq lst   (cons (strcat pre (itoa pos) "," "0.000," (rtos (caddr pt) 2 3)) lst)
	 parpt pt
   );; setq
   (setq lst (cons (strcat pre (itoa pos) "," (rtos (distance (list (car pt) (cadr pt)) (list (car parpt) (cadr parpt))) 2 3) "," (rtos (caddr pt) 2 3)) lst)
	 parpt pt
   );; setq
 );; if
 (setq par (1+ par))
      );; while
      (if lst
 (progn
   (setq lst (reverse lst)
	 fo  (open fn "w")
   );; setq
   (foreach l lst
     (write-line l fo)
   );; foreach
   (close fo)
 );; progn
      );; if
    );; progn
 );; if
 (princ)
);; demo

HTH

Henrique

Thank you hmsilva.I have a question. if i want to export more data from the polyline how can i do it? For examle after the between distanse colum i want to add a distanse from the begening colum and the the elevetion

D1,0.000,0.000,5.568

D2,36.776,36.776,6.221

D3,10.089,46.865,5.429

D4,13.984,60.849,5.519

D5,16.574,77.423,5.407

Thank you hmsilva.I have a question. if i want to export more data from the polyline how can i do it? For examle after the between distanse colum i want to add a distanse from the begening colum and the the elevetion

You're welcome, prodromosm!

Try

(defun c:demo (/ acdist e fn fo lst par parpt pdist poly pos pre pt s)
 (prompt "\nSelect a 3DPolyline to extract Stations and Elevations to txt file: ")
 (if
   (and (setq s (ssget "_+.:E:S" '((0 . "POLYLINE") (-4 . "&") (70 . )))
 (setq fn (getfiled "Enter the output filename:" (getvar 'DWGPREFIX) "txt" 1))
 (setq pre (strcase (getstring "\nEnter station prefix:")))
   );; and
    (progn
      (setq poly (vlax-ename->vla-object (ssname s 0))
     e	  (fix (vlax-curve-getEndParam poly))
     pos  0
     par  0
     acdist 0.0;; <--Start accumulated distance
     lst  nil
      );; setq
      (while (/= par (1+ e))
 (setq pt  (vlax-curve-getPointAtParam poly par)
       pos (1+ pos)
 );; setq
 (if (not parpt)
   (setq lst   (cons (strcat pre (itoa pos) "," "0.000,0.000," (rtos (caddr pt) 2 3)) lst)
	 parpt pt
   );; setq
   (setq lst (cons (strcat pre (itoa pos) ","
			   ;; store the partial distance at the pdist variable
			   (rtos (setq pdist (distance (list (car pt) (cadr pt)) (list (car parpt) (cadr parpt)))) 2 3)
			   ;; adding acdist and pdist, and store the accumulated distance at acdist variable
			   "," (rtos (setq acdist (+ acdist pdist)) 2 3)
			   "," (rtos (caddr pt) 2 3)) lst)
	 parpt pt
   );; setq
 );; if
 (setq par (1+ par))
      );; while
      (if lst
 (progn
   (setq lst (reverse lst)
	 fo  (open fn "w")
   );; setq
   (foreach l lst
     (write-line l fo)
   );; foreach
   (close fo)
 );; progn
      );; if
    );; progn
 );; if
 (princ)
);; demo

HTH

Henrique

Thank you hmsilva.

You're welcome, prodromosm

Henrique

Hi , hmsilva can you make a change the post #3 code to export files like the attach.

1) select the start point (dimension 0.000)

2) I whant the minus (-) to be allways to the left side of the direction of polyline

look the attach

test1.dwg

from 2 to 1.txt

from 1 to 2.txt

A work in progress 1 program a lot of answers. Like Hmsilva feel free to use bits of it.

; pline example listing various properties like pts and lengths
; By Alan H 2014

(defun getcoords (ent)
 (vlax-safearray->list
   (vlax-variant-value
     (vlax-get-property
   (vlax-ename->vla-object ent)
   "Coordinates"
     )
   )
 )
)

(defun getlength (ent)
     (vlax-get-property (vlax-ename->vla-object ent) "Length")

)

(defun co-ords2xy ()
; convert now to xyz
(setq xyprin "\n") ; new line
(if (= xyz 2)
(progn
(setq I 0)
(repeat (/ len 2)
(setq x (nth i co-ords))
(setq y (nth (+ I 1) co-ords))
(setq xy (list  x y))
(setq xyprin (strcat xyprin "\n" (rtos x 2 2) "," (rtos y 2 2 )))
(setq co-ordsxy (cons xy co-ordsxy))
(setq I (+ I 2))
) ; repeat
) ; progn
) ; if

(if (= xyz 3)
(progn
(setq xyprin "\n") ; new line
(setq I 0)
(repeat (/ len 3)
(setq x (nth i co-ords))
(setq y (nth (+ I 1) co-ords))
(setq z (nth (+ I 2) co-ords))
(setq xy (list x y z))
(setq xyprin (strcat xyprin "\n" (rtos x 2 2) "," (rtos y 2 2 ) "," (rtos z 2 2 )))
(setq co-ordsxy (cons xy co-ordsxy))
(setq I (+ I 3))
) ; repeat
) ; progn
) ; if
) ; defun

; program starts here
(setq ent (car (entsel "\nPlease pick pline")))
(setq co-ords (getcoords ent ))
(setq len (length co-ords))

; check for odd even list 2d v's 3d
(setq oddeven (- (fix (/ len 2.0))(/ len 2.0))) 
(if (= oddeven 0.5)
(setq xyz 3) ; 3d pline
(setq xyz 2) ; 2d pline
)

(setq numvert (/ len xyz))
(princ (strcat "\nNumber of vertices " (rtos numvert 2 0)))

(co-ords2xy)
(princ xyprin) ; prints out points co-ords

(setq pllen (getlength))
(princ (strcat "\nActual length of pline " (rtos pllen 2 2)))

; to be done (princ segment lengths 2d)
; tobe done (princ segment lengths 3d) if different
; to be done (princ angle of segments)
; to be done (princ delta angle of segments

(princ)

Hi , hmsilva can you make a change to the code in the post #5

in the post #5 we have this results

D1,0.000,0.000,5.568

D2,36.776,36.776,6.221

D3,10.089,46.865,5.429

D4,13.984,60.849,5.519

D5,16.574,77.423,5.407

Thank you

Can you change it to export only

0.000,5.568

36.776,6.221

46.865,5.429

60.849,5.519

77.423,5.407

Hi , hmsilva can you make a change to the code in the post #5

in the post #5 we have this results

Thank you

Can you change it to export only

Hi prodromosm,

as I had said earlier

"I think it's time for you to start trying to write your own codes."

So, I did add some annotations to the code you want to modify, it's an easy task, try yourself to modify the code, if you have any questions, just asks...

(if (not parpt);; tests for parpt existence, if not, initializes the lst list with the first string
 (setq lst (cons;; to add elements to the lst list
(strcat;; to concatenate multiple strings in one
pre;; first sting element, the prefix i.e D
(itoa pos);; the prefix index
"," "0.000,0.000,";; second and third string elements, the partial and accumulated distances
(rtos (caddr pt) 2 3);; the fourth string element, the Z value
);; strcat
lst);; cons
parpt pt;; sets parpt with the pt value
);; setq
;; if the lst list is already initialized, just continues to add strings to the lst list
 (setq lst (cons;; to add elements to the lst list
(strcat;; to concatenate multiple strings in one
pre;; first sting element, the prefix i.e D
(itoa pos);; the prefix index
",";; the first comma separator
;; store the partial distance at the pdist variable
(rtos (setq pdist (distance (list (car pt) (cadr pt)) (list (car parpt) (cadr parpt)))) 2 3)
",";; the second comma separator
;; the third string element adding acdist and pdist,
;; and store the accumulated distance at acdist variable
(rtos (setq acdist (+ acdist pdist)) 2 3)
",";; the third comma separator	
(rtos (caddr pt) 2 3);; the fourth string element, the Z value
);; strcat
lst);; cons
parpt pt;; sets parpt with the pt value
);; setq
 );; if

HTH

Henrique

Hi , hmsilva can you help me with this error i try to change the code to export only

0.000,5.568

36.776,6.221

46.865,5.429

60.849,5.519

77.423,5.407

But now i can not export any file !!!

(defun c:demo (/ e fn fo lst par parpt poly pos pre pt s)
 (prompt "\nSelect a 3DPolyline to extract Stations and Elevations to txt file: ")
 (if
   (and (setq s (ssget "_+.:E:S" '((0 . "POLYLINE") (-4 . "&") (70 . )))
 (setq fn (getfiled "Enter the output filename:" (getvar 'DWGPREFIX) "txt" 1))
     );; and
    (progn
      (setq poly (vlax-ename->vla-object (ssname s 0))
     e	  (fix (vlax-curve-getEndParam poly))
     pos  0
     par  0
     lst  nil
      );; setq
      (while (/= par (1+ e))
 (if (not parpt)
   (setq lst   (cons (strcat  "," "0.000," (rtos (caddr pt) 2 3)) lst)
	 parpt pt
   );; setq
   (setq lst (cons (strcat "," (rtos (setq acdist (+ acdist pdist)) 2 3) "," (rtos (caddr pt) 2 3)) lst)
	 parpt pt
   );; setq
 );; if
 (setq par (1+ par))
      );; while
      (if lst
 (progn
   (setq lst (reverse lst)
	 fo  (open fn "w")
   );; setq
   (foreach l lst
     (write-line l fo)
   );; foreach
   (close fo)
 );; progn
      );; if
    );; progn
 );; if
 (princ)
);; demo

Thanks

But now i can not export any file !!!

Hi prodromosm,

A quick fix...

(defun c:demo (/ acdist e fn fo lst par parpt pdist poly pos pre pt s)
 (prompt "\nSelect a 3DPolyline to extract Stations and Elevations to txt file: ")
 (if
   (and (setq s (ssget "_+.:E:S" '((0 . "POLYLINE") (-4 . "&") (70 . )))
 (setq fn (getfiled "Enter the output filename:" (getvar 'DWGPREFIX) "txt" 1))
 ; no prefix
 ;|(setq pre (strcase (getstring "\nEnter station prefix:")))|;
   );; and
    (progn
      (setq poly (vlax-ename->vla-object (ssname s 0))
     e	  (fix (vlax-curve-getEndParam poly))
     pos  0
     par  0
     acdist 0.0
     lst  nil
      );; setq
      (while (/= par (1+ e))
 (setq pt  (vlax-curve-getPointAtParam poly par)
       pos (1+ pos)
 );; setq
 (if (not parpt)
   (setq lst (cons (strcat
	 ;|pre (itoa pos) "," "0.000,"|;
	 "0.000," (rtos (caddr pt) 2 3)) lst)
	 parpt pt
);; setq
   ;; the pdist variable is needed to the accumulated the distance
   (setq pdist (distance (list (car pt) (cadr pt)) (list (car parpt) (cadr parpt)))
	 lst (cons (strcat
	    ;|pre (itoa pos) ","
	    (rtos (setq pdist (distance (list (car pt) (cadr pt)) (list (car parpt) (cadr parpt)))) 2 3) ","|;
	    (rtos (setq acdist (+ acdist pdist)) 2 3)
	    "," (rtos (caddr pt) 2 3)) lst)
	 parpt pt
	 );; setq
   );; if
 (setq par (1+ par))
      );; while
      (if lst
 (progn
   (setq lst (reverse lst)
	 fo  (open fn "w")
   );; setq
   (foreach l lst
     (write-line l fo)
   );; foreach
   (close fo)
   (startapp "notepad" fn);; added to open the new txt file
 );; progn
      );; if
    );; progn
 );; if
 (princ)
);; demo

Untested, I have no AutoCAD with me right now...

Henrique

With or without AutoCAD you are the best my fried !!!

Thanks

You're welcome, prodromosm!

See the differences between your code and mine, and try to find out why your code didn't worked as expected.

Cheers

Henrique

Hi hmsilva is it possible to update to export data using a center line .

look the attach file and you will understand

test1.dwg

export data.txt

prodromosm, try this revision...

(defun c:demo (/ acdcp acdist cp e fn fo lst osm par parpt pdist poly
              pos pre pt s)

 (vl-load-com)

 (setq osm (getvar 'osmode))
 (setvar 'osmode 1)
 (prompt
   "\nSelect a 3DPolyline to extract Stations and Elevations to txt file: "
 )
 (if
   (and (setq s (ssget "_+.:E:S" '((0 . "POLYLINE") (-4 . "&") (70 . )))
        (setq fn (getfiled "Enter the output filename:"
                           (getvar 'DWGPREFIX)
                           "txt"
                           1
                 )
        )
                                       ; no prefix
        ;|(setq pre (strcase (getstring "\nEnter station prefix:")))|;
        (setq cp (getpoint "\nClick or specify center point : "))
   );; and
    (progn
      (setq poly   (vlax-ename->vla-object (ssname s 0))
            e      (fix (vlax-curve-getEndParam poly))
            pos    0
            par    0
            acdist 0.0
            lst    nil
            cp     (vlax-curve-getClosestPointToProjection
                     poly
                     cp
                     '(0.0 0.0 1.0)
                   )
      )
      ;; setq
      (while (/= par (1+ e))
        (setq pt  (vlax-curve-getPointAtParam poly par)
              pos (1+ pos)
        )
        ;; setq
        (if (not parpt)
          (setq lst   (cons (strcat
                             ;|pre (itoa pos) "," "0.000,"|;
                              "0.000,"
                              (rtos (caddr pt) 2 3)
                            )
                            lst
                      )
                parpt pt
          )
          ;; setq
          ;; the pdist variable is needed to the accumulated the distance
          (setq pdist (distance (list (car pt) (cadr pt))
                                (list (car parpt) (cadr parpt))
                      )
                lst   (cons (strcat
                             ;|pre (itoa pos) ","
           (rtos (setq pdist (distance (list (car pt) (cadr pt)) (list (car parpt) (cadr parpt)))) 2 3) ","|;
                              (rtos (setq acdist (+ acdist pdist)) 2 3)
                              ","
                              (rtos (caddr pt) 2 3)
                            )
                            lst
                      )
                parpt pt
          )
          ;; setq
        )
        ;; if
        (if (equal pt cp 1e-
          (setq acdcp (- acdist))
        )
        (setq par (1+ par))
      )
      ;; while
      (if lst
        (progn
          (setq lst (mapcar '(lambda (x)
                               (strcat (rtos (+ (atof x) acdcp) 2 3)
                                       (substr x (1+ (vl-string-search "," x)))
                               )
                             )
                            (reverse lst)
                    )
                fo  (open fn "w")
          )
          ;; setq
          (foreach l lst
            (write-line l fo)
          )
          ;; foreach
          (close fo)
          (startapp "notepad" fn)
          ;; added to open the new txt file
        )
        ;; progn
      )
      ;; if
    )
    ;; progn
 )
 ;; if
 (setvar 'osmode osm)
 (princ)
)
;; demo

Regards, Marko Ribar, d.i.a.

prodromosm, try this revision...

 

Regards, Marko Ribar, d.i.a.

Good man!

Thank you marko_ribar