Lisp for total line length for lines which in every separately box

[mss_selcukuni]

Hi Everyone,

I want to make this with lisp in Autocad... 

I want to export totale line lenght to excel table..

but i want to see lenght of lines with their box name with lenght..

Pls see example in attachment,

Can you help me pls this issue

[mss_selcukuni]

Dear @hak_vz;

I'm so sorry... 😞

I hope you get well soon.. I wish we can did our lisp to finaly.

dont forget me pls..

[mss_selcukuni]

@hak_vz,

Are you here my friend?

[mss_selcukuni]

Hi Everyone...

Thank you to @hak_vz  for this perfect code..

This is wonderful for me..

But @hak_vz X is take caring of with health issues.. I whis He will be good and come here again soon..

I putted example documents (excel and Autocad).

Can you add addition to code to seperate layer name...

I want to seperate to different rows with by layer name in addition by box name..

can you help me please?

[CADaSchtroumpf]

Hi,

You can try this : press Enter at prompt "Area name >" for quit the loop and finish the job

(defun PolylineByLayer (l_pt / ss i pline layer value lst sub)
  (if (setq ss (ssget "_WP" l_pt (append (list '(0 . "LWPOLYLINE,LINE") (cons 410 (getvar "CTAB"))))))
    (repeat (setq i (sslength ss))
      (setq pline (ssname ss (setq i (1- i)))
        layer (getpropertyvalue (getpropertyvalue pline "LayerId") "Name")
        value (getpropertyvalue pline "Length")
      )
      (setq lst
        (if (setq sub (assoc layer lst))
          (subst (list layer (1+ (cadr sub)) (+ (caddr sub) value)) sub lst)
          (cons (list layer 1 value) lst)
        )
      )
    )
  )
)
(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:boxinfo ( / areaname js ent dxf_ent lst_pt data)
  (while (/= (setq areaname (getstring "\nArea name >")) "")
    (princ "\nSelect selection boundary")
    (while (null (setq js (ssget "_+.:E:S" '((0 . "LWPOLYLINE") (90 . 4)))))
      (princ "\nOject isn't valide")
    )
    (setq
      ent (ssname js 0)
      dxf_ent (entget ent)
      lst_pt (mapcar '(lambda (x) (trans x ent 0)) (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) dxf_ent)))
      data (append  (mapcar '(lambda (x) (cons areaname x))(PolylineByLayer lst_pt)) data)
    )
  )
  (if data (WriteExcel (cons (list "Box name" "Layer" "Item" "Length") data)))
  (prin1)
)

[mss_selcukuni]

Hi,
I cant run this code... 😕

[CADaSchtroumpf]

---

@mss_selcukuni  a écrit :
Hi,
I cant run this code... 😕

---

You have a full version of Autocad? or you use for exemple Briscad...?

If it is a full version, you can try before to run (vl-load-com) before (I forget it in the code)

[mss_selcukuni]

Hi, Thank you so much,

1) Yes you are right.. My program is ZWCad..

We can run with ZW Cad?
2) we can draw shape which not such as rectangle.. Pls see attachments..

3) and last one, can we calculate area like @hak_vz 's code...

Can you help me?

[CADaSchtroumpf]

I don't if this can get work in ZWCad, but you can try... (I doubt the function: (getpropertyvalue ....))

I not use Excel but write in CSV

(defun PolylineByLayer (l_pt / ss i pline layer len area lst sub)
  (if (setq ss (ssget "_WP" l_pt (append (list '(0 . "LWPOLYLINE,LINE") (cons 410 (getvar "CTAB"))))))
    (repeat (setq i (sslength ss))
      (setq pline (ssname ss (setq i (1- i)))
        layer (cdr (assoc 8 (entget pline)))
        len (vlax-curve-getdistatparam pline (vlax-curve-getendparam pline))
        area (vlax-curve-getarea pline)
      )
      (setq lst
        (if (setq sub (assoc layer lst))
          (subst (list layer (1+ (cadr sub)) (+ (caddr sub) len) (+ (cadddr sub) area)) sub lst)
          (cons (list layer 1 len area) lst)
        )
      )
    )
  )
)
(defun c:boxinfo ( / areaname js ent dxf_ent lst_pt data tmp f_open str_sep oldim)
  (while (/= (setq areaname (getstring "\nArea name >")) "")
    (princ "\nSelect selection boundary")
    (while (null (setq js (ssget "_+.:E:S" '((0 . "LWPOLYLINE")))))
      (princ "\nOject isn't valide")
    )
    (setq
      ent (ssname js 0)
      dxf_ent (entget ent)
      lst_pt (mapcar '(lambda (x) (trans x ent 0)) (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) dxf_ent)))
      data (append  (mapcar '(lambda (x) (cons areaname x))(PolylineByLayer lst_pt)) data)
    )
  )
  (setq
    tmp (vl-filename-mktemp "tmp.csv")
    f_open (open tmp "w")
    str_sep ";"
    oldim (getvar "dimzin")
  )
  (setvar "dimzin" 0)
  (write-line
    (apply 'strcat (list "Box name" str_sep "Layer" str_sep "Item" str_sep "Length" str_sep "Area" str_sep))
    f_open
  )
  (mapcar
    '(lambda (y)
      (write-line
        (apply 'strcat
          (mapcar
            '(lambda (x)
              (strcat
                (cond
                  ((eq (type x) 'STR) x)
                  ((eq (type x) 'INT) (itoa x))
                  ((eq (type x) 'REAL) (rtos x 2 2))
                  (T "")
                )
                str_sep
              )
            )
            y
          )
        )
        f_open
      )
    )
    data
  )
  (close f_open)
  (startapp "notepad" tmp)
  (setvar "dimzin" oldim)
  (prin1)
)

[mss_selcukuni]

Hi,
Can you add code which I want at @hak_vz' s code which is in his last post?
So can you edit his code?
Maybe it can run at zwcad

[mss_selcukuni]

@CADaSchtroumpf 

Yes, you are right.. 

This code isnt working..

this is error: bad function type - GETPROPERTYVALUE

But, @hak_vz 's code is working on ZWcad.. Can you edit this code?

[CADaSchtroumpf]

@mss_selcukuni 

I have edited my previous post for don't use GETPROPERTYVALUE in my code.

Try again with this modification.

[mss_selcukuni]

Your lisp open notpad..
I want to open Excel... 😕

[mss_selcukuni]

Just i want to added line layer name...
(and ı install autocad 🙂 )

[CADaSchtroumpf]

Take the function from hak_vz and insert it at the beginning of the code.

(defun _openfile (file / sh)
  ;thanks to @ronjohnp
  (setq sh (vlax-get-or-create-object "Shell.Application"))
  (vlax-invoke-method sh 'open (findfile file))
  (vlax-release-object sh)
)

and at the end of the code just change:

(startapp "notepad" tmp)

by

(_openfile tmp)

You will be able to do that...?

[mss_selcukuni]

sorry.. 

But its okey.. only can you add area value like lenght?

(defun PolylineByLayer (l_pt / ss i pline layer value lst sub)
  (if (setq ss (ssget "_WP" l_pt (append (list '(0 . "LWPOLYLINE,LINE") (cons 410 (getvar "CTAB"))))))
    (repeat (setq i (sslength ss))
      (setq pline (ssname ss (setq i (1- i)))
        layer (getpropertyvalue (getpropertyvalue pline "LayerId") "Name")
        value (getpropertyvalue pline "Length")
      )
      (setq lst
        (if (setq sub (assoc layer lst))
          (subst (list layer (1+ (cadr sub)) (+ (caddr sub) value)) sub lst)
          (cons (list layer 1 value) lst)
        )
      )
    )
  )
)
(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:boxinfo ( / areaname js ent dxf_ent lst_pt data)
  (while (/= (setq areaname (getstring "\nArea name >")) "")
    (princ "\nSelect selection boundary")
    (while (null (setq js (ssget "_+.:E:S" '((0 . "LWPOLYLINE")))))
      (princ "\nOject isn't valide")
    )
    (setq
      ent (ssname js 0)
      dxf_ent (entget ent)
      lst_pt (mapcar '(lambda (x) (trans x ent 0)) (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) dxf_ent)))
      data (append  (mapcar '(lambda (x) (cons areaname x))(PolylineByLayer lst_pt)) data)
    )
  )
  (if data (WriteExcel (cons (list "Box name" "Layer" "Item" "Length") data)))
  (prin1)
)

[CADaSchtroumpf]

What do you end up using? ZWCad or AutoCAD... 😩

With AutoCAD

(defun PolylineByLayer (l_pt / ss i pline layer len area lst sub)
  (if (setq ss (ssget "_WP" l_pt (append (list '(0 . "LWPOLYLINE,LINE") (cons 410 (getvar "CTAB"))))))
    (repeat (setq i (sslength ss))
      (setq pline (ssname ss (setq i (1- i)))
        layer (cdr (assoc 8 (entget pline)))
        len (vlax-curve-getdistatparam pline (vlax-curve-getendparam pline))
        area (vlax-curve-getarea pline)
      )
      (setq lst
        (if (setq sub (assoc layer lst))
          (subst (list layer (1+ (cadr sub)) (+ (caddr sub) len) (+ (cadddr sub) area)) sub lst)
          (cons (list layer 1 len area) lst)
        )
      )
    )
  )
)
(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:boxinfo ( / areaname js ent dxf_ent lst_pt data)
  (while (/= (setq areaname (getstring "\nArea name >")) "")
    (princ "\nSelect selection boundary")
    (while (null (setq js (ssget "_+.:E:S" '((0 . "LWPOLYLINE")))))
      (princ "\nOject isn't valide")
    )
    (setq
      ent (ssname js 0)
      dxf_ent (entget ent)
      lst_pt (mapcar '(lambda (x) (trans x ent 0)) (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) dxf_ent)))
      data (append  (mapcar '(lambda (x) (cons areaname x))(PolylineByLayer lst_pt)) data)
    )
  )
  (if data (WriteExcel (cons (list "Box name" "Layer" "Item" "Length" "Area") data)))
  (prin1)
)

[mss_selcukuni]

oh... well done.. Thank you sooo much @CADaSchtroumpf 

I use Autocad finaly 🙂

Thanks thanks thanks so much.. 🙂

[mss_selcukuni]

Can i ask 2 thing if it is not hard? 😕 😥

1)

When we "select" boundary box, can we select with "select box"?

Now we can select "select point"..

Can you please see attachment?

2)

can you add for circle and ellipse?

[CADaSchtroumpf]

---

@mss_selcukuni  a écrit :

Can i ask 2 thing if it is not hard? 😕 😥

1)

When we "select" boundary box, can we select with "select box"?

Now we can select "select point"..

Can you please see attachment?

2)

can you add for circle and ellipse?

---

This?

(defun PolylineByLayer (l_pt / ss i pline ename layer len area lst sub)
  (if (setq ss (ssget "_WP" l_pt (append (list '(0 . "LWPOLYLINE,LINE,SPLINE,CIRCLE,ELLIPSE") (cons 410 (getvar "CTAB"))))))
    (repeat (setq i (sslength ss))
      (setq
        pline (ssname ss (setq i (1- i)))
        ename (vlax-ename->vla-object pline)
        layer (cdr (assoc 8 (entget pline)))
      )
      (if (member (vlax-get ename 'ObjectName) '("AcDbEllipse" "AcDbSpline"))
        (setq len (vlax-curve-getDistAtParam ename (vlax-curve-getEndParam ename)))
        (foreach typ_measure '("Length" "Circumference" "Perimeter")
          (if (vlax-property-available-p ename (read typ_measure))
            (setq len (vlax-get ename (read typ_measure)))
          )
        )
      )
      (if (vlax-property-available-p ename "Area")
        (setq area (vlax-get ename 'Area))
        (setq area 0.0)
      )
      (setq lst
        (if (setq sub (assoc layer lst))
          (subst (list layer (1+ (cadr sub)) (+ (caddr sub) len) (+ (cadddr sub) area)) sub lst)
          (cons (list layer 1 len area) lst)
        )
      )
    )
  )
)
(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:boxinfo ( / areaname js ent dxf_ent lst_pt data)
  (while (/= (setq areaname (getstring "\nArea name >")) "")
    (princ "\nSelect selection boundary")
    (while (/= (sslength (setq js (ssget  '((0 . "LWPOLYLINE"))))) 1)
      (princ "\nOject isn't valide or selection have too many objects")
    )
    (setq
      ent (ssname js 0)
      dxf_ent (entget ent)
      lst_pt (mapcar '(lambda (x) (trans x ent 0)) (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) dxf_ent)))
      data (append  (mapcar '(lambda (x) (cons areaname x))(PolylineByLayer lst_pt)) data)
    )
  )
  (if data (WriteExcel (cons (list "Box name" "Layer" "Item" "Length" "Area") data)))
  (prin1)
)

[mss_selcukuni]

Thank you so much @hak_vz   and @CADaSchtroumpf 

This code is wonderful for uss...