extraction of xy coordinates & radius from pline

[Anonymous]

hello guys...

I use a lisp for extraction of xy coordinates but sometimes pline has radius. 

I would like to extract xy coordinates & radius from pline.

for example …

;-------------------------------------------------------------------------------

(defun c:xyout2( / ss ssi xys_list en ent ename xy k )

(setq ss (ssget '((0 . "LW*,POLYLINE")))
ssl (sslength ss)
i 0

xy_list nil)
(while (> ssl i)
(setq en (ssname ss i)
ent (entget en)
ename (cdr (assoc 0 ent))
i (1+ i)
xy (cdr (assoc 10 ent)))
(cond ((= ename "POLYLINE")
(setq en (entnext en)
k (entget en))
(while (/= ename "SEQEND")
(setq xy_list (append xy_list (list (cdr (assoc 10 k))))
en (entnext en)

k (entget en)
ename (cdr (assoc 0 k)))))
((= ename "LWPOLYLINE")
(setq z (cdr (assoc 38 ent)))
(foreach k ent
(if (= (car k) 10)
(setq xy_list (append xy_list (list (append (cdr k) (list z))))))))))
(setq i 0)
(TEXTSCR)
(write-line "no\tX\tY\tZ" file)
(foreach k xy_list
(write-line (strcat "No." (itoa i) "\t" (rtos (car k) 2 4)  "\t"  (rtos (cadr k) 2 4) "\t" (rtos (caddr k) 2 4)) file)
(setq i (1+ i))
)
(princ)
)

[Anonymous]

for example … result should be as below ...

no      R      X      Y           Z

No.0  0     0.0    100.0     0.0
No.1   0    90.0   100.0   0.0
No.2   10  100.0    90.0  0.0
No.3   0    100.0    0.0    0.0
No.4   0    0.0        0.0    0.0

Please help me...…..

[dlanorh]

Try this:

;; Polyline Report Ron Harman (dlanorh) Copyright © 2019
(vl-load-com)
(defun rh:sammlung_n (o_lst grouping / tmp n_lst)
  (setq n_lst nil)
  (if (= (rem (length o_lst) grouping) 0)
    (while o_lst
      (while (< (length tmp) grouping)
        (setq tmp (cons (car o_lst) tmp)
              o_lst (cdr o_lst)
        );end_setq
      );end_while
      (setq n_lst (cons (reverse tmp) n_lst)
            tmp nil
      );end_setq
    );end_while
    (princ "\nModulus Error : The passed list length is not exactly divisible by the group size!!")
  );end_if
  (reverse n_lst)
);end_defun rh:sammlung_n

(defun rh:get_file ( title fname ext flg )
  (if (not ext) (setq ftype "*" ext ".*") (setq ftype (vl-string-left-trim "." ext)))
  (cond ( (not flg) (setq fname (getfiled title (strcat (getvar 'dwgprefix) fname ext) ftype 1)))
        (flg (setq fname (getfiled title (strcat (getvar 'dwgprefix) fname ext) ftype 12)))
  );end_cond
);end_defun

(defun c:PR (/ *error* sv_lst sv_vals c_doc fname fp p_lst o_type z v_lst cnt ll ur c_lst t_lst)

  (defun *error* ( msg )
    (if fp (close fp))
    (mapcar 'setvar sv_lst sv_vals)
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nAn Error : " msg " occurred.")))
    (princ)
  );end_*error*_defun

  (setq sv_lst (list 'cmdecho 'osmode)
        sv_vals (mapcar 'getvar sv_lst)
        c_doc (vla-get-activedocument (vlax-get-acad-object))
  );end_setq

  (mapcar 'setvar sv_lst '(0 0 0))

  (setq fname (rh:get_file "Enter CSV File Name for Output" (vl-filename-base (getvar 'dwgname)) ".csv" nil))

  (prompt "\nSelect Polylines ")
  (setq ss (ssget '((0 . "LWPOLYLINE,POLYLINE"))))
  (cond (ss
          (setq fp (open fname "w"))
          (write-line "No ,R,X,Y,Z" fp)
          (repeat (setq cnt (sslength ss))
            (setq obj (vlax-ename->vla-object (ssname ss (setq cnt (1- cnt)))))
            (cond ( (= (vlax-get-property obj 'objectname) "AcDb2dPolyline")
                    (setq v_lst (mapcar '(lambda (x) (reverse (cons z (reverse x)))) (rh:sammlung_n (vlax-get obj 'coordinates) 3)))
                  )
                  ( (setq z (vlax-get obj 'elevation)
                          v_lst (mapcar '(lambda (x) (reverse (cons z (reverse x)))) (rh:sammlung_n (vlax-get obj 'coordinates) 2))
                    );end_setq
                  )
            )
            (setq vtx 0)
            (foreach v v_lst
              (setq bulge (vlax-invoke obj 'getbulge (float vtx)))
              (if (/= 0.0 bulge) (setq rad (distance '(0. 0. 0.) (vlax-curve-getsecondderiv obj (float vtx)))) (setq rad 0.0))
              (write-line (strcat (itoa vtx) ","
                                  (rtos rad 2 3) ","
                                  (rtos (car v) 2 3) ","
                                  (rtos (cadr v) 2 3) ","
                                  (rtos (caddr v) 2 3) ","
                          );end_strcat
                          fp
              );end_write-line
              (setq vtx (1+ vtx))
            );end_foreach
            (write-line "" fp)
          );end_repeat
        )
  );end_cond
  (if fp (close fp))
  (mapcar 'setvar sv_lst sv_vals)
  (princ)
);end_defun

[Sea-Haven]

Have a look on www.lee-mac.com he has a nice pline info lisp displays more info that you may want also.