export polyline length to excel

[pmadhwal7]

Hi everybody

i have multiple polyline in my files and i want to export all of them in excel but not one by one like if i select all the polyline and export it in excel, and length should be in sequence wise example is as per attached screen shot,

 

Edited February 20 by pmadhwal7

[devitg]

@pmadhwal7 There is no pline at your dwg .

 

Did you try to use DATAEXTRACTION ?

 

It will do what you need . 

 

[devitg]

@pmadhwal7

 

 

find attached result for my sample  by DATAEXTRACTION

legends-01.dwg dit+clr.dxe legends.xls

[pmadhwal7]

On 2/17/2024 at 5:22 PM, devitg said:

@pmadhwal7 There is no pline at your dwg .

 

Did you try to use DATAEXTRACTION ?

 

It will do what you need . 

 

yes i was tried it actually dataextraction give length randomly and i want length where polyline start and where end continuously like my screen shot first line length is 161,then 467 

[devitg]

On 2/17/2024 at 5:40 AM, pmadhwal7 said:

Hi everybody

i have multiple polyline in my files and i want to export all of them in excel but not one by one like if i select all the polyline and export it in excel, and length should be in sequence wise example is as per attached screen shot,

legends.dwg 223.74 kB · 1 download

@pmadhwal7there are no continuos polylines at this DWG , please upload 

 

 

 

 

[pmadhwal7]

19 hours ago, devitg said:

@pmadhwal7there are no continuos polylines at this DWG , please upload 

 

 

 

 

By mistake i was upload wrong file kindly find the corrected one, as per this when i export length i want first length of blue line then green line then red line

LENGTH.dwg

Edited February 20 by pmadhwal7

[Tsuky]

This ?

(vl-load-com)
(defun WriteExcel (data / xlApp wBook cells i j)
  (setq
    xlApp (vlax-create-object "Excel.Application")
    wBook (vlax-invoke-method (vlax-get-property xlapp 'WorkBooks) 'Add)
    cells (vlax-get-property xlApp 'Cells)
    i 0
  )
  (foreach row data
    (setq i (1+ i) j 0)
    (foreach val row
      (setq
        j (1+ j)
        cell (vlax-variant-value (vlax-get-property cells 'Item i j))
      )
      (vlax-put-property cell 'Value2 val)
    )
  )
  (vlax-invoke-method
    (vlax-get-property
      (vlax-get-property xlApp 'ActiveSheet)
      'Columns
    )
    'AutoFit
  )
  (vlax-put-Property xlApp 'Visible :vlax-true)
)
(defun c:length2excel ( / ss n ent e_col e_length data)
  (setq ss (ssget "_X" '((0 . "LWPOLYLINE"))))
  (cond
    (ss
      (repeat (setq n (sslength ss))
        (setq
          ent (ssname ss (setq n (1- n)))
          e_col
          (if (assoc 62 (entget ent))
            (cdr (assoc 62 (entget ent)))
            (cdr (assoc 62 (entget (tblobjname "LAYER" (cdr (assoc 8 (entget ent)))))))
          )
          e_length (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent))
          data (cons (list e_length e_col) data)
        )
      )
      (if data
        (WriteExcel
          (cons
            (list "LENGTH" "Color")
            (reverse (vl-sort data '(lambda (e1 e2) (< (cadr e1) (cadr e2)))))
          )
        )
      )
    )
  )
  (prin1)
)

 

[BIGAL]

Just a suggestion, is Excel already open ?

 

(or (setq myxl (vlax-get-object "Excel.Application"))
    (setq myxl (vlax-get-or-create-object "excel.Application"))
)

 

So maybe need a more complicated if/test and only "Add" if required. 

 

 

 

 

 

 

[pmadhwal7]

18 hours ago, Tsuky said:

This ?

(vl-load-com)
(defun WriteExcel (data / xlApp wBook cells i j)
  (setq
    xlApp (vlax-create-object "Excel.Application")
    wBook (vlax-invoke-method (vlax-get-property xlapp 'WorkBooks) 'Add)
    cells (vlax-get-property xlApp 'Cells)
    i 0
  )
  (foreach row data
    (setq i (1+ i) j 0)
    (foreach val row
      (setq
        j (1+ j)
        cell (vlax-variant-value (vlax-get-property cells 'Item i j))
      )
      (vlax-put-property cell 'Value2 val)
    )
  )
  (vlax-invoke-method
    (vlax-get-property
      (vlax-get-property xlApp 'ActiveSheet)
      'Columns
    )
    'AutoFit
  )
  (vlax-put-Property xlApp 'Visible :vlax-true)
)
(defun c:length2excel ( / ss n ent e_col e_length data)
  (setq ss (ssget "_X" '((0 . "LWPOLYLINE"))))
  (cond
    (ss
      (repeat (setq n (sslength ss))
        (setq
          ent (ssname ss (setq n (1- n)))
          e_col
          (if (assoc 62 (entget ent))
            (cdr (assoc 62 (entget ent)))
            (cdr (assoc 62 (entget (tblobjname "LAYER" (cdr (assoc 8 (entget ent)))))))
          )
          e_length (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent))
          data (cons (list e_length e_col) data)
        )
      )
      (if data
        (WriteExcel
          (cons
            (list "LENGTH" "Color")
            (reverse (vl-sort data '(lambda (e1 e2) (< (cadr e1) (cadr e2)))))
          )
        )
      )
    )
  )
  (prin1)
)

 

yes but the only thing is after green line sequence are changed 194m length come before 245, kindly modified it

 

[pmadhwal7]

12 hours ago, BIGAL said:

Just a suggestion, is Excel already open ?

 

(or (setq myxl (vlax-get-object "Excel.Application"))
    (setq myxl (vlax-get-or-create-object "excel.Application"))
)

 

So maybe need a more complicated if/test and only "Add" if required. 

 

 

 

 

 

 

video are attached how i currently doing (through lisp export_polyline length)

export_polyline length.LSP

length1.csv

Edited February 21 by pmadhwal7

[Tsuky]

10 hours ago, pmadhwal7 said:

yes but the only thing is after green line sequence are changed 194m length come before 245, kindly modified it

 

What you wont?

Sort by length:

(vl-load-com)
(defun WriteExcel (data / xlApp wBook cells i j)
  (setq
    xlApp (vlax-create-object "Excel.Application")
    wBook (vlax-invoke-method (vlax-get-property xlapp 'WorkBooks) 'Add)
    cells (vlax-get-property xlApp 'Cells)
    i 0
  )
  (foreach row data
    (setq i (1+ i) j 0)
    (foreach val row
      (setq
        j (1+ j)
        cell (vlax-variant-value (vlax-get-property cells 'Item i j))
      )
      (vlax-put-property cell 'Value2 val)
    )
  )
  (vlax-invoke-method
    (vlax-get-property
      (vlax-get-property xlApp 'ActiveSheet)
      'Columns
    )
    'AutoFit
  )
  (vlax-put-Property xlApp 'Visible :vlax-true)
)
(defun c:length2excel ( / ss n ent e_col e_length data)
  (setq ss (ssget "_X" '((0 . "LWPOLYLINE"))))
  (cond
    (ss
      (repeat (setq n (sslength ss))
        (setq
          ent (ssname ss (setq n (1- n)))
          e_col
          (if (assoc 62 (entget ent))
            (cdr (assoc 62 (entget ent)))
            (cdr (assoc 62 (entget (tblobjname "LAYER" (cdr (assoc 8 (entget ent)))))))
          )
          e_length (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent))
          data (cons (list e_length e_col) data)
        )
      )
      (if data
        (WriteExcel
          (cons
            (list "LENGTH" "Color")
            (vl-sort
              (vl-sort
                data
                '(lambda (e1 e2) (< (car e1) (car e2)))
              )
              '(lambda (e1 e2) (> (cadr e1) (cadr e2)))
            )
          )
        )
      )
    )
  )
  (prin1)
)

 

Or sort by order of maked entities:

(vl-load-com)
(defun WriteExcel (data / xlApp wBook cells i j)
  (setq
    xlApp (vlax-create-object "Excel.Application")
    wBook (vlax-invoke-method (vlax-get-property xlapp 'WorkBooks) 'Add)
    cells (vlax-get-property xlApp 'Cells)
    i 0
  )
  (foreach row data
    (setq i (1+ i) j 0)
    (foreach val row
      (setq
        j (1+ j)
        cell (vlax-variant-value (vlax-get-property cells 'Item i j))
      )
      (vlax-put-property cell 'Value2 val)
    )
  )
  (vlax-invoke-method
    (vlax-get-property
      (vlax-get-property xlApp 'ActiveSheet)
      'Columns
    )
    'AutoFit
  )
  (vlax-put-Property xlApp 'Visible :vlax-true)
)
(defun c:length2excel ( / ss n ent e_col e_length e_id data)
  (setq ss (ssget "_X" '((0 . "LWPOLYLINE"))))
  (cond
    (ss
      (repeat (setq n (sslength ss))
        (setq
          ent (ssname ss (setq n (1- n)))
          e_col
          (if (assoc 62 (entget ent))
            (cdr (assoc 62 (entget ent)))
            (cdr (assoc 62 (entget (tblobjname "LAYER" (cdr (assoc 8 (entget ent)))))))
          )
          e_length (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent))
          e_id (cdr (assoc 5 (entget ent)))
          data (cons (list e_length e_col e_id) data)
        )
      )
      (if data
        (WriteExcel
          (cons
            (list "LENGTH" "Color")
            (mapcar
              '(lambda (x) (list (car x) (cadr x)))
              (vl-sort
                (vl-sort
                  data
                  '(lambda (e1 e2) (> (caddr e1) (caddr e2)))
                )
                '(lambda (e1 e2) (> (cadr e1) (cadr e2)))
              )
            )
          )
        )
      )
    )
  )
  (prin1)
)

 

[BIGAL]

"Or sort by order of maked entities:" maybe pick 1st pline then look at each end/start point is there another pline touching. Interesting problem as must look at pline direction. Does Cyan pline go in opposite direction to green & red ?

 

[pmadhwal7]

4 hours ago, BIGAL said:

"Or sort by order of maked entities:" maybe pick 1st pline then look at each end/start point is there another pline touching. Interesting problem as must look at pline direction. Does Cyan pline go in opposite direction to green & red ?

 

actually not fixed which color comes first it depend on data received from field sometime complete line are green sometime mixed

[pmadhwal7]

On 2/20/2024 at 3:32 PM, Tsuky said:

This ?

(vl-load-com)
(defun WriteExcel (data / xlApp wBook cells i j)
  (setq
    xlApp (vlax-create-object "Excel.Application")
    wBook (vlax-invoke-method (vlax-get-property xlapp 'WorkBooks) 'Add)
    cells (vlax-get-property xlApp 'Cells)
    i 0
  )
  (foreach row data
    (setq i (1+ i) j 0)
    (foreach val row
      (setq
        j (1+ j)
        cell (vlax-variant-value (vlax-get-property cells 'Item i j))
      )
      (vlax-put-property cell 'Value2 val)
    )
  )
  (vlax-invoke-method
    (vlax-get-property
      (vlax-get-property xlApp 'ActiveSheet)
      'Columns
    )
    'AutoFit
  )
  (vlax-put-Property xlApp 'Visible :vlax-true)
)
(defun c:length2excel ( / ss n ent e_col e_length data)
  (setq ss (ssget "_X" '((0 . "LWPOLYLINE"))))
  (cond
    (ss
      (repeat (setq n (sslength ss))
        (setq
          ent (ssname ss (setq n (1- n)))
          e_col
          (if (assoc 62 (entget ent))
            (cdr (assoc 62 (entget ent)))
            (cdr (assoc 62 (entget (tblobjname "LAYER" (cdr (assoc 8 (entget ent)))))))
          )
          e_length (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent))
          data (cons (list e_length e_col) data)
        )
      )
      (if data
        (WriteExcel
          (cons
            (list "LENGTH" "Color")
            (reverse (vl-sort data '(lambda (e1 e2) (< (cadr e1) (cadr e2)))))
          )
        )
      )
    )
  )
  (prin1)
)

 

hi check this new file i was uploaded and just match the following table length with given dwg file i hope u got my words after that 

LENGTH.dwg

[Tsuky]

To obtain this result, you must apply @BIGAL’s advice.

13 hours ago, BIGAL said:

maybe pick 1st pline then look at each end/start point is there another pline touching.

For the moment I cannot satisfy your request, maybe later...

[pmadhwal7]

@BIGAL can you help me please

[Tsuky]

Try with this version which processes polylines using junction points.

(vl-load-com)
(defun list_pt_sel (e_l fz / )
  (if (equal (vlax-curve-getStartPoint (car e_l)) (cadr e_l) fz)
    (list (car e_l) (vlax-curve-getStartPoint (car e_l)) (vlax-curve-getEndPoint (car e_l)))
    (list (car e_l) (vlax-curve-getEndPoint (car e_l)) (vlax-curve-getStartPoint (car e_l)))
  )
)
(defun WriteExcel (data / xlApp wBook cells i j)
  (setq
    xlApp (vlax-create-object "Excel.Application")
    wBook (vlax-invoke-method (vlax-get-property xlapp 'WorkBooks) 'Add)
    cells (vlax-get-property xlApp 'Cells)
    i 0
  )
  (foreach row data
    (setq i (1+ i) j 0)
    (foreach val row
      (setq
        j (1+ j)
        cell (vlax-variant-value (vlax-get-property cells 'Item i j))
      )
      (vlax-put-property cell 'Value2 val)
    )
  )
  (vlax-invoke-method
    (vlax-get-property
      (vlax-get-property xlApp 'ActiveSheet)
      'Columns
    )
    'AutoFit
  )
  (vlax-put-Property xlApp 'Visible :vlax-true)
)
(defun c:length2excel ( / ent dxf_ent dfzz start_pt js_all e_master lst_o pt_start e_other lst_e lst ent e_col e_length data)
  (while
    (or
      (not (setq ent (entsel "\nSelect base polyline: ")))
      (not (eq (if ent (cdr (assoc 0 (setq dxf_ent (entget (car ent))))) "") "LWPOLYLINE"))
    )
  )
  (if (not dfzz) (setq dfzz 1E-08))
  (initget 9)
  (setq
    start_pt (trans (getpoint "\nDesignate an end point of the base polyline: ") 1 0)
    start_pt (vlax-curve-getClosestPointToProjection (car ent) start_pt (cdr (assoc 210 dxf_ent)) T)
  )
  (princ "\nSelect the polylines to process: ")
  (while (not (setq js_all (ssget '((0 . "LWPOLYLINE"))))))
  (if (ssmemb (car ent) js_all)
    (ssdel (car ent) js_all)
  )
  (setq
    e_master (list (car ent) start_pt)
    lst_o (list_pt_sel e_master dfzz)
    pt_start (caddr lst_o)
  )
  (repeat (setq n (sslength js_all))
    (setq e_other (cons (ssname js_all (setq n (1- n))) e_other))
  )
  (cond
    (e_other
      (setq lst (list lst_o))
      (while e_other
        (setq lst_e (list_pt_sel (list (car e_other) pt_start) dfzz))
        (if (equal (cadr lst_e) pt_start dfzz)
          (setq lst (cons lst_e lst) e_other (cdr e_other) pt_start (caddr lst_e))
          (setq e_other (append (cdr e_other) (list (car e_other))))
        )
      )
    )
    (T (setq lst (list lst_o)))
  )
  (cond
    (lst
      (mapcar
        '(lambda (x)
          (setq
            ent (car x)
            e_col
            (if (assoc 62 (entget ent))
              (cdr (assoc 62 (entget ent)))
              (cdr (assoc 62 (entget (tblobjname "LAYER" (cdr (assoc 8 (entget ent)))))))
            )
            e_length (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent))
            data (cons (list e_length e_col) data)
          )
        )
        lst
      )
      (if data
        (WriteExcel
          (cons
            (list "LENGTH" "Color")
            data
          )
        )
      )
    )
  )
  (prin1)
)

 

[BIGAL]

Tsuky just a comment

(entsel "\nSelect base polyline: ")

(getpoint "\nDesignate an end point of the base polyline: " Not required

 

When you pick a pline near and end, entsel returns the pick point, you can compare the distance between Pick point -> start point and Pick point -> end point so gives direction of pline, you can if required reverse the pline direction, so once done for 1st pline can again repeat for next pline.

 

An example using points but can use "Pedit" "R" to reverse a pline and get points in direction order.

(defun swapends (ent / obj)
(setq pt3 (cadr ent))
(setq obj (vlax-ename->vla-object (car ent)))
(setq start (vlax-curve-getstartPoint obj))
(setq end (vlax-curve-getEndPoint obj))
(setq d1 (distance pt3 end))
(setq d2 (distance pt3 start))
(if (< d1 d2)
(progn
(setq temp end)
(setq end start)
(setq start temp)
)
)
(princ)
)

 

[pmadhwal7]

14 minutes ago, BIGAL said:

Tsuky just a comment

(entsel "\nSelect base polyline: ")

(getpoint "\nDesignate an end point of the base polyline: " Not required

 

When you pick a pline near and end, entsel returns the pick point, you can compare the distance between Pick point -> start point and Pick point -> end point so gives direction of pline, you can if required reverse the pline direction, so once done for 1st pline can again repeat for next pline.

 

An example using points but can use "Pedit" "R" to reverse a pline and get points in direction order.

(defun swapends (ent / obj)
(setq pt3 (cadr ent))
(setq obj (vlax-ename->vla-object (car ent)))
(setq start (vlax-curve-getstartPoint obj))
(setq end (vlax-curve-getEndPoint obj))
(setq d1 (distance pt3 end))
(setq d2 (distance pt3 start))
(if (< d1 d2)
(progn
(setq temp end)
(setq end start)
(setq start temp)
)
)
(princ)
)

 

how to use this can u please explain me

[pmadhwal7]

15 hours ago, Tsuky said:

Try with this version which processes polylines using junction points.

(vl-load-com)
(defun list_pt_sel (e_l fz / )
  (if (equal (vlax-curve-getStartPoint (car e_l)) (cadr e_l) fz)
    (list (car e_l) (vlax-curve-getStartPoint (car e_l)) (vlax-curve-getEndPoint (car e_l)))
    (list (car e_l) (vlax-curve-getEndPoint (car e_l)) (vlax-curve-getStartPoint (car e_l)))
  )
)
(defun WriteExcel (data / xlApp wBook cells i j)
  (setq
    xlApp (vlax-create-object "Excel.Application")
    wBook (vlax-invoke-method (vlax-get-property xlapp 'WorkBooks) 'Add)
    cells (vlax-get-property xlApp 'Cells)
    i 0
  )
  (foreach row data
    (setq i (1+ i) j 0)
    (foreach val row
      (setq
        j (1+ j)
        cell (vlax-variant-value (vlax-get-property cells 'Item i j))
      )
      (vlax-put-property cell 'Value2 val)
    )
  )
  (vlax-invoke-method
    (vlax-get-property
      (vlax-get-property xlApp 'ActiveSheet)
      'Columns
    )
    'AutoFit
  )
  (vlax-put-Property xlApp 'Visible :vlax-true)
)
(defun c:length2excel ( / ent dxf_ent dfzz start_pt js_all e_master lst_o pt_start e_other lst_e lst ent e_col e_length data)
  (while
    (or
      (not (setq ent (entsel "\nSelect base polyline: ")))
      (not (eq (if ent (cdr (assoc 0 (setq dxf_ent (entget (car ent))))) "") "LWPOLYLINE"))
    )
  )
  (if (not dfzz) (setq dfzz 1E-08))
  (initget 9)
  (setq
    start_pt (trans (getpoint "\nDesignate an end point of the base polyline: ") 1 0)
    start_pt (vlax-curve-getClosestPointToProjection (car ent) start_pt (cdr (assoc 210 dxf_ent)) T)
  )
  (princ "\nSelect the polylines to process: ")
  (while (not (setq js_all (ssget '((0 . "LWPOLYLINE"))))))
  (if (ssmemb (car ent) js_all)
    (ssdel (car ent) js_all)
  )
  (setq
    e_master (list (car ent) start_pt)
    lst_o (list_pt_sel e_master dfzz)
    pt_start (caddr lst_o)
  )
  (repeat (setq n (sslength js_all))
    (setq e_other (cons (ssname js_all (setq n (1- n))) e_other))
  )
  (cond
    (e_other
      (setq lst (list lst_o))
      (while e_other
        (setq lst_e (list_pt_sel (list (car e_other) pt_start) dfzz))
        (if (equal (cadr lst_e) pt_start dfzz)
          (setq lst (cons lst_e lst) e_other (cdr e_other) pt_start (caddr lst_e))
          (setq e_other (append (cdr e_other) (list (car e_other))))
        )
      )
    )
    (T (setq lst (list lst_o)))
  )
  (cond
    (lst
      (mapcar
        '(lambda (x)
          (setq
            ent (car x)
            e_col
            (if (assoc 62 (entget ent))
              (cdr (assoc 62 (entget ent)))
              (cdr (assoc 62 (entget (tblobjname "LAYER" (cdr (assoc 8 (entget ent)))))))
            )
            e_length (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent))
            data (cons (list e_length e_col) data)
          )
        )
        lst
      )
      (if data
        (WriteExcel
          (cons
            (list "LENGTH" "Color")
            data
          )
        )
      )
    )
  )
  (prin1)
)

 

when i was exporting length my autocad hang and after that i was press esc key for coming back to autocad and lisp not working