Extracting Coordinates from a polyline

[Bin2009]

Hello,

I am trying to get a lisp extract the X and Y coordinates of series points on a polyline

First situation is the points divide polyline with  equal interval (for example 1 meter).

without lisp, I can do is use measure command, put points along polyline every 1 meter, then use dataextraction to get all points coordinates.

Second situation, the points have equal increasing on x. For example, increase 1 meter each time, I need find y value at the point x =  1, 2, 3,.... until end.

without lips, I can do is drawing array of lines with interval 1 meter, then trim them by the polyline, use dataextaction to get all lines end point y value.

I hope can have some lisps to solve my two problems and speed up my work, highly appreciate if anyone can help!

Thanks, 

Bin

[kajanthangavel · Accepted solution]

Try this.

for your first requirement

It working Like this

(defun c:brk (/ *error* k_len kchain file ov dis cEnt pt)
  (vl-load-com)

	(defun *error* (msg)
		(close file)
		(command "_.UNDO" "_B")
		(mapcar 'setvar svnames svvals)
		(if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
		(princ (strcat "\n<< Error: " msg " >>")))
		(princ)
	)

	(command "_.UNDO" "_M")
	(vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object))))
	(setq svnames '(osmode cmdecho blipmode plinewid))
	(setq svvals (mapcar 'getvar svnames))
	(setq kchain 1)
	(setq file (open (strcat (getvar 'dwgprefix) "coordnate.csv") "w"))
	(mapcar 'setvar svnames '(0 0 0 0))
	(write-line (strcat "Number" "," "X-Coor" "," "Y-Coor" "," "X-Coor") file)
	(or (= (type k_len) 'REAL)(setq k_len 1.0))
	(not (initget 6))
		(if (setq dis (getdist (strcat "\nLength of stripe <" (rtos k_len (getvar "lunits") 2) ">: ")))
			(setq k_len dis)
			(setq dis k_len)
		)
	(while (and (setq cEnt (car (entsel "\nSelect Polyline: ")))
				(vl-position (cdadr (entget cEnt)) '("LINE" "LWPOLYLINE" "POLYLINE" "ARC" "SPLINE")))
		(while (and (setq pt (vlax-curve-getPointatDist cEnt dis))
					(>= (distance pt (vlax-curve-getEndPoint cEnt)) dis))
					
		(command "_.break" (list cEnt pt) "_F" pt pt)

			(princ (strcat "
"(rtos kchain 2 0) "," (rtos (car pt) 2 3) "," (rtos (cadr pt) 2 3) "," (rtos (caddr pt) 2 3)))
			(progn
				(write-line (strcat (rtos kchain 2 0) "," (rtos (car pt) 2 3) "," (rtos (cadr pt) 2 3) "," (rtos (caddr pt) 2 3)) file)
				(setq kchain (+ kchain 1))
			)
		(setq cEnt (entlast))
		)
	)
	(close file)
	(command "_.UNDO" "_B")
	(mapcar 'setvar svnames svvals)
	(vla-endundomark doc)
(princ)
)

I am not Lisp Expert

[kajanthangavel]

This it your 2nd requirement

This is working like this

This is working sample

Try this code

(defun C:xcoor (/ *error* doc svnames svvals ss n plobj LL xl xlobj intc file kchain k_len dis)

  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
      (princ (strcat "\nError: " errmsg))
    )
    (mapcar 'setvar svnames svvals)
    (vla-endundomark doc)
	(close file)
    (princ)
  )
 
(vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object))))
(setq svnames '(osmode cmdecho blipmode plinewid))
(setq svvals (mapcar 'getvar svnames))
(setq file (open (strcat (getvar 'dwgprefix) "X_level_corrdinate.csv") "w"))
(write-line (strcat "Number" "," "X-Coor" "," "Y-Coor") file)
(mapcar 'setvar svnames '(0 0 0 0))
(setq kchain 1)
	(or (= (type k_len) 'REAL)(setq k_len 1.0))
	(not (initget 6))
		(if (setq dis (getdist (strcat "\nX axsi Length <" (rtos k_len (getvar "lunits") 1) ">: ")))
			(setq k_len dis)
			(setq dis k_len)
		)
(prompt "\nSelect Polyline(s),")
  (if (setq ss (ssget '((0 . "*POLYLINE"))))
    (progn
      (mapcar 'setvar svnames '(0 0 0 0))
      (repeat	(setq n (sslength ss))
				(setq plobj (vlax-ename->vla-object (ssname ss (setq n (1- n)))))
				(vla-getboundingbox plobj 'minpt 'maxpt)
				(setq LL (vlax-safearray->list minpt))
				(command "_.xline" "_ver" LL "")
				(setq xl (entlast) xlobj (vlax-ename->vla-object xl))
				(repeat (1+ (fix (/ (- (car (vlax-safearray->list maxpt)) (car LL)) dis)))
					(setq intc (vlax-invoke plobj 'IntersectWith xlobj acExtendNone))
					(princ (strcat "
					" (rtos kchain 2 0) " " (rtos (car intc) 2 3) " " (rtos (cadr intc) 2 3)))
					(write-line (strcat (rtos kchain 2 0) "," (rtos (car intc) 2 3) "," (rtos (cadr intc) 2 3)) file)
					(command "_.move" xl "" (list dis 0) "")
					(setq kchain (+ kchain 1))
				)
				(entdel xl)
      )
    )
    (prompt "\nNo Polyline(s) selected.")
  )
(close file)

(mapcar 'setvar svnames svvals)
(vla-endundomark doc)
(princ)
)

I am not lisp expert

I hope this is help you.

[Bin2009]

Hello kajanthangavel,

Thank very much for your lisp, I think you helped me before.

I tried this lisp, it works great when the polyline made from lines, but if the polyline contain curves, it looks can't go through, could you please help, I attach one polyline I need work with.

Thanks so much!

Bin

[Bin2009]

Hello kajanthangavel,

Thank very much for your lisp,  it works great!

Bin

[kajanthangavel]

Hi

Its work for me

.

See that, working sample.

Try with this lisp.

(If  (not work)

      (post your AutoCAD Version)

      (Enjoy)

)

"Sorry for late reply, Because I went vacation."