LISP TO CALCULATE LENGTH AND CREATE TABLE BY LAYER

[inaamazmi]

Is there a lisp that can calulate the total length of object (arc,polyline,line) in same layer and create a table of layer name and length

[Sea-Haven · Accepted solution]

More than likely, and probably lots of them, did you google it is a very common question.

[Moshe-A · Accepted solution]

@inaamazmi  hi,

here is my version.

table scale is controlled by dimscale and the length is in current drawing units.

lines, arcs, plines, splines & arc ellipse all fair game 😀

enjoy

Moshe

(vl-load-com) ; Load ActiveX support

; total curves length
(defun c:tcl (/ collect_data draw_table ; local functions
	        DIMSCL adoc p0 data^)

 (defun collect_data (/ curveLen layName ss elist)
  (vlax-for AcDbLayTblRec (vla-get-layers adoc)
   (setq curveLen 0 layName (vla-get-name AcDbLayTblRec)) 
   (if (setq ss (ssget "_x" (list (cons '8 layName) '(0 . "line,arc,*polyline,spline,ellipse"))))
    (progn 
     (foreach ename (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
      (setq elist (entget ename)) 
      (cond   
       ((and
          (wcmatch (cdr (assoc '0 elist)) "ELLIPSE")   ; arc ellipse
 	  (not (equal (cdr (assoc '42 elist)) pi 1e-3))
        )
        (setq curveLen (+ curveLen (vlax-curve-getDistAtParam ename (vlax-curve-getEndParam ename))))
       ); case
       ( t
        (setq curveLen (+ curveLen (vlax-curve-getDistAtParam ename (vlax-curve-getEndParam ename))))
       )
      ); cond
     ); foreach
     (setq data^ (cons (cons layName curveLen) data^))
    ); progn
   ); if

   (vlax-release-object AcDbLayTblRec)
  ); vlax-for
 ); collect_data


 (defun draw_table (/ modelSpace AcDbTable i)
  (setq modelSpace (vla-get-ModelSpace adoc))
  (setq AcDbTable (vla-Addtable modelSpace (vlax-3d-point (trans p0 1 0)) (+ (vl-list-length data^) 2) 2 (* DIMSCL 0.4) (* DIMSCL 3.6)))

  (vla-setText AcDbTable 0 0 "Schedule Length by Layer")
  (vla-setText AcDbTable 1 0 "Layer Name")
  (vla-setText AcDbTable 1 1 "Length")
  (vla-setColumnWidth AcDbTable 1 (* DIMSCL 1.8)) 

  (setq i 0) 
  (foreach item (reverse data^)
   (setq i (1+ i)) 
   (vla-setText AcDbTable (1+ i) 0 (car item))
   (vla-setText AcDbTable (1+ i) 1 (rtos (cdr item) 2 2))
  ); foreach

  (vlax-release-object AcDbTable)
  (vlax-release-object modelSpace) 
 ); draw_table 


 ; here start c:tcl
 (setq DIMSCL (getvar "dimscale")) ; const
  
 (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-startUndoMark adoc)
  
 (if (setq p0 (getpoint "\nTable upper left corner: "))
  (progn 
   (collect_data)
   (draw_table)
  ); progn 
 ); if 
  
 (vla-endUndoMark adoc)
 (vlax-release-object adoc)
  
 (princ)
); c:tcl