LayerLength Modification

[CAD_Noob]

I need help to modify this lisp. Credit to the author, my friend just gave this to me.

 

What it does is Select multiple Polylines and creates a table of all the selected polylines showing its Layer name and total Length,

My issue is that our drawings are in millimeter. Can somebody help me to modify the lisp and change the total length in the table to Meters

If we can add a polyline with the layer color in another column of the table, that would be a great addition but not necessary.

 

Here is the lisp : 

 

(defun C:LAYLENGTH ( / *error* acdoc ss p i e a d l) (vl-load-com)
  (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark acdoc)

  (defun *error* (msg)
    (and
      msg
      (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*,*EXIT*"))
      (princ (strcat "\nError: " msg))
    )
    (if
      (= 8 (logand (getvar 'undoctl) 8))
      (vla-endundomark acdoc)
    )
    (princ)
    )
  
  (if
    (and
      (setq ss (ssget ":L" '((0 . "LINE,POLYLINE,LWPOLYLINE,ARC,CIRCLE,ELLIPSE,SPLINE"))))
      (setq p (getpoint "\nTable scale depend on annotation scale.\nSpecify table insert point: "))
      )
    (progn
      (repeat
        (setq i (sslength ss))
        (setq e (ssname ss (setq i (1- i)))
              a (cdr (assoc 8 (entget e)))
              d (vlax-curve-getdistatparam e (vlax-curve-getendparam e))
        )
        (if
          (setq o (assoc a l))
          (setq l (subst (list a (+ (cadr o) d)) o l))
          (setq l (cons (list a d) l))
        )
      )
      (setq l (vl-sort l '(lambda (a b) (< (car a) (car b)))))
      (insert_table l p)
      )
    )
  (*error* nil)
  (princ)
  )

(defun insert_table (lst pct / tab row col ht i n space)
  (setq space (vlax-get acDoc (if (= 1 (getvar 'cvport)) 'PaperSpace 'ModelSpace))
        ht  (/ 2.5 (cond ((getvar 'cannoscalevalue)) (1.0)))
        pct (trans pct 1 0)
        n   (trans '(1 0 0) 1 0 T)
        tab (setq tab (vla-addtable space (vlax-3d-point pct) (+ 2 (length lst)) (length (car lst)) (* 2.5 ht) ht))
        )
  (vlax-put tab 'direction n)
  
  (mapcar
    (function
      (lambda (rowType)
        (vla-SetTextStyle  tab rowType (getvar 'textstyle))
        (vla-SetTextHeight tab rowType ht)
      )
    )
   '(2 4 1)
  )
  
  (vla-put-HorzCellMargin tab (* 0.14 ht))
  (vla-put-VertCellMargin tab (* 0.14 ht))

  (setq lst (cons (mapcar '(lambda (a) (strcat "Col" (itoa (1+ (vl-position a (car lst)))))) (car lst)) lst))

  (setq i 0)
  (foreach col (apply 'mapcar (cons 'list lst))
    (vla-SetColumnWidth tab i
      (apply
        'max
        (mapcar
          '(lambda (x)
             ((lambda (txb) (+ (abs (- (caadr txb) (caar txb))) (* 2.0 ht)))
              (textbox (list (cons 1 (vl-princ-to-string x)) (cons 7 (getvar 'textstyle)) (cons 40 ht)))
              )
             )
          col
          )
        )
      )
    (setq i (1+ i))
    )
  
  (setq lst (cons '("TITLE") lst))
  
  (setq row 0)
  (foreach r lst
    (setq col 0)
    (vla-SetRowHeight tab row (* 1.5 ht))
    (foreach c r
      (vla-SetText tab row col (if (numberp c) (rtos c) (vl-princ-to-string c)))
      (setq col (1+ col))
      )
    (setq row (1+ row))
    )
  )

 

[mhupp]

Divide c by 1000 when its a number. replace the last part of the lisp.

 

  (foreach r lst
    (setq col 0)
    (vla-SetRowHeight tab row (* 1.5 ht))
    (foreach c r
      (vla-SetText tab row col 
        (if (numberp c) 
          (rtos (/ c 1000) 2 3)  ;change 3 to show that many decimal places
          (vl-princ-to-string c)
        )
      )
      (setq col (1+ col))
    )
    (setq row (1+ row))
  )
)

 

 

[CAD_Noob]

12 hours ago, mhupp said:

Divide c by 1000 when its a number. replace the last part of the lisp.

 

  (foreach r lst
    (setq col 0)
    (vla-SetRowHeight tab row (* 1.5 ht))
    (foreach c r
      (vla-SetText tab row col 
        (if (numberp c) 
          (rtos (/ c 1000) 2 3)  ;change 3 to show that many decimal places
          (vl-princ-to-string c)
        )
      )
      (setq col (1+ col))
    )
    (setq row (1+ row))
  )
)

 

 

 

 

Thank you so much...

 

I want to do the same to this lisp...Making tables by giving height to polylines - AutoLISP, Visual LISP & DCL - AutoCAD Forums (cadtutor.net)

Edited October 19, 2022 by CAD_Noob

[CAD_Noob]

13 hours ago, mhupp said:

Divide c by 1000 when its a number. replace the last part of the lisp.

 

  (foreach r lst
    (setq col 0)
    (vla-SetRowHeight tab row (* 1.5 ht))
    (foreach c r
      (vla-SetText tab row col 
        (if (numberp c) 
          (rtos (/ c 1000) 2 3)  ;change 3 to show that many decimal places
          (vl-princ-to-string c)
        )
      )
      (setq col (1+ col))
    )
    (setq row (1+ row))
  )
)

 

 

 

Can i ask for one more? How do i change the Title in the table to match with the drawing filename without the .dwg extension?

[mhupp]

2 hours ago, CAD_Noob said:

 

Can i ask for one more? How do i change the Title in the table to match with the drawing filename without the .dwg extension?

 

 

(setq lst (cons '("TITLE") lst)) ;replace this line
(setq lst (cons (vl-filename-base (getvar 'dwgname)) lst)) ;with this

 

--edit

also near the end

Edited October 19, 2022 by mhupp

[CAD_Noob]

1 hour ago, mhupp said:

 

 

(setq lst (cons '("TITLE") lst)) ;replace this line
(setq lst (cons (vl-filename-base (getvar 'dwgname)) lst)) ;with this

 

--edit

also near the end

 

Thank you so much... 

I only put getvar 'dwgname it doesn't work hehehe.