Help? Total length on every Layer

Hello,

I want an autolisp that can make the totol length of lines ,polylines, splines and arcs for layername1, layername2 and layername3.And give the result in a TABLE :

length table

layer

total length

layername1

123

layername2

456

layername3

789

THE TABLE.pdf

Try this one from my oldies

 
;;TotalsToTable.lsp
(defun c:TTT ( / acsp adoc col cols data ip l lr lrs num objs row rows sset sub tbl tmp tot)
(vl-load-com)
(setq adoc (vla-get-activedocument (vlax-get-acad-object))
acsp (vla-get-block (vla-get-activelayout adoc))
)
(if (setq sset (ssget "X"
'((-4 . "<OR")
(0 . "*LINE")
(0 . "CIRCLE")
(0 . "ARC")
(0 . "ELLIPSE")
(-4 . "OR>")
(-4 . "<NOT")
(0 . "MLINE")
(-4 . "NOT>")
)
)
)
(progn
(setq objs (mapcar 'vlax-ename->vla-object
(mapcar 'cadr (ssnamex sset))
)
)
(setq lrs nil)
(foreach obj objs
(if (not (member (setq lr (vla-get-layer obj)) lrs))
(setq lrs (cons lr lrs))
)
)
(setq data nil)
(foreach lr lrs
(setq sub (vl-remove-if-not
'(lambda (o) (eq (vla-get-layer o) lr))
objs
)
)
(setq tot 0)
(foreach obj sub
(setq tot (+ tot
(vlax-curve-getdistatparam
obj
(vlax-curve-getendparam obj)
)
)
)
)
(setq tmp (cons lr tot))
(setq data (cons tmp data))
)
(setq
data (vl-sort data '(lambda (a b) (< (car a) (car b))))
)
(setq ip (getpoint "\nPick table position: "))
(if (zerop (setq txh (getvar "textsize")))
(setq txh (getvar "dimtxt"))
)
(setq tbl (vlax-invoke
acsp
'addtable
ip
(+ (length data) 2)
2
(* txh 20)
(* txh 20)
)
)
(vla-put-regeneratetablesuppressed tbl :vlax-true)
(vla-setrowheight tbl 0 (* txh 3))
(vla-setrowheight tbl 1 (* txh 2.5))
(vla-settext tbl 0 0 "[url="file://c12;title/"]\\C12;TITLE[/url]")
(vla-settext tbl 1 0 "[url="file://c5;layer/"]\\C5;Layer[/url] Name")
(vla-settext tbl 1 1 "[url="file://c5;total/"]\\C5;Total[/url] Length")
(setq row 2)
(foreach x data
(vla-setrowheight tbl row (* txh 2))
(vla-settext tbl row 0 (car x))
(vla-settext tbl row 1 (rtos (cdr x) 2 3))
(setq row (1+ row))
)
(vla-settextheight tbl actitlerow (* txh 3))
(vla-settextheight tbl (+ acheaderrow acdatarow) (* txh 2))
(vla-setcolumnwidth tbl 0 (* txh 20))
(vla-setcolumnwidth tbl 1 (* txh 20))
(vla-put-regeneratetablesuppressed tbl :vlax-false)
)
(princ "\nNothing selected.")
)

(princ)
)

(princ "\n Start with: \"TTT\"")
(prin1)

~'J'~

Too lazy to write a table rouitne

(defun c:TLenAll ( / _length ss e cur data lyn ip txh tbl row)
(setq _Length (lambda (en)
                (vlax-get en
                      (if (vlax-property-available-p en
                                'Length) "Length"  "ArcLength"))
                )[b][color=blue] Lyns "Layer1,Layer2,Layer3");<---- your layers
[/color][/b]      (if (setq ss (ssget [color=blue][b] (list[/b][/color] '(0 . "*LINE,ARC")
                            [b][color=blue](cons 8  lyns)[/color][/b])))
[color=darkred][b];;; If the layers are constant, might as well include it here ;;;
;;;          (setq ss (ssget  '((0 . "*LINE,ARC")   ;;;
;;;                             (8 . "Layer1,Layer2,Layer3"))))  ;;;
[/b][/color]          (progn
      (repeat (sslength ss)
      (setq e (vlax-ename->vla-object (ssname ss 0)))
      (if (setq cur (assoc (setq lyn (vla-get-layer e)) data))
            (setq data (subst (list (car cur)
                                     (+ (_Length e) (cadr cur)))
                               cur
                               data))
            (setq data (cons
                              (list lyn (_Length e))
                              data))
            )
      (ssdel (ssname ss 0) ss)
      )
(setq data (vl-sort  data
                                  '(lambda (a b)
                                         (< (car a) (car b))))
                       )
                 (setq ip (getpoint "\nPick table position: "))
                 (if (zerop (setq txh (getvar "textsize")))
                       (setq txh (getvar "dimtxt"))
                       )
                 (setq tbl (vlax-invoke
                                 (vlax-get (vla-get-ActiveLayout
                    (vla-get-activedocument (vlax-get-acad-object)))
                                        'Block)
                                 'addtable
                                 ip
                                 (+ (length data) 2)
                                 2
                                 (* txh 20)
                                 (* txh 20)
                                 )
                       )
                 (vla-put-regeneratetablesuppressed tbl :vlax-true)
                 (vla-setrowheight tbl 0 (* txh 3))
                 (vla-setrowheight tbl 1 (* txh 2.5))
                 (vla-settext tbl 0 0 "[url="file://\\C12;Length"]\\C12;Length[/url] Table")
                 (vla-settext tbl 1 0 "[url="file://\\C5;Layer"]\\C5;Layer[/url] Name")
                 (vla-settext tbl 1 1 "[url="file://\\C5;Total"]\\C5;Total[/url] Length")
                 (setq row 2)
                 (foreach
                        x  data
                       (vla-setrowheight tbl row (* txh 2))
                       (vla-settext tbl row 0 (car x))
                       (vla-settext tbl row 1 (rtos (cadr x) 2 3))
                       (setq row (1+ row))
                       )
                 (vla-settextheight tbl actitlerow (* txh 3))
                 (vla-settextheight
                       tbl
                       (+ acheaderrow acdatarow)
                       (* txh 2))
                 (vla-setcolumnwidth tbl 0 (* txh 20))
                 (vla-setcolumnwidth tbl 1 (* txh 20))
                 (vla-put-regeneratetablesuppressed tbl :vlax-false)
                 )(princ "\nNo Objects Found:")
)(princ)
     )

Everything else's Fixo code (kudos)

You can add layers to the list , as many as you want as shown in red into the routine .....

(defun c:Test (/ hgt e inc increment Layers insertionPoint tbl lengths
              lst r selectionset integer selectionsetname
             )
 (vl-load-com)
;;; Tharwat 21 . May . 2012 ;;;
 (if (not acdoc)
   (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
 )
 (setq
   hgt (if
         (zerop
           (cdr
             (assoc
               40
               (setq
                 e (entget (tblobjname "STYLE" (getvar 'textstyle)))
               )
             )
           )
         )
          (cdr (assoc 42 e))
          (cdr (assoc 40 e))
       )
 )
 (setq increment -1
       [color=red][color=black]Layers [/color][b]   '("Layer1" "Layer2" "Layer3")[/b][/color]
       lengths   0
 )
 (setq r 1)
 (repeat (length Layers)
   (if (setq selectionset
              (ssget
                "_x"
                (list
                  '(0 . "LINE,*POLYLINE,SPLINE,ARC")
                  (cons
                    8
                    (nth (setq increment (1+ increment)) layers)
                  )
                )
              )
       )
     (progn
       (repeat (setq integer (sslength selectionset))
         (setq selectionsetname
                (ssname selectionset
                        (setq integer (1- integer))
                )
         )
         (setq lengths (+ (vlax-curve-getDistatPoint
                            selectionsetname
                            (vlax-curve-getEndPoint selectionsetname)
                          )
                          lengths
                       )
         )
       )
       (if lengths
         (setq lst (cons (cons lengths (nth increment Layers)) lst))
       )
       (setq lengths 0)
     )
   )
 )
 (if lst
   (setq insertionPoint (getpoint "\n Specify Table Location :"))
 )
 (setq tbl (vla-addtable
             (vla-get-modelspace acdoc)
             (vlax-3d-point insertionPoint)
             (+ (length layers) 2)
             2
             (* hgt 2.5)
             (* hgt 2.5)
           )
 )
 (setq inc -1)
 (repeat 2
   (vla-setcolumnwidth tbl 0 (* hgt 10.))
   (vla-setcolumnwidth tbl 1 (* hgt 10.))
   (vla-setrowheight tbl (setq inc (1+ inc)) (* hgt 1.5))
 )
 (vla-settext tbl 0 0 "Length table")
 (vla-settext tbl 1 0 "Layer")
 (vla-settext tbl 1 1 "Length Total")
 (if lst
   (foreach x (reverse lst)
     (vla-settext tbl (setq r (1+ r)) 0 (cdr x))
     (vla-setcellalignment tbl r 0 acMiddleCenter)
     (vla-settext tbl r 1 (rtos (car x) 2))
     (vla-setcellalignment tbl r 1 acMiddleCenter)
   )
 )
 (princ)
)

@pBe

Circles do not have the property Length neither ArcLength my friend

@pBe

 

Circles do not have the property Length neither ArcLength my friend

Yup. forgot to remove that when i saw the OP's list of entiteis only when i realized its not included

lines ,polylines, splines and arcs

thank you for reminding me

Yup. forgot to remove that when i saw the OP's list of entiteis.

 

thank you for reminding me

It's my pleasure

Thank you for everybody and you Tharwat.

Your code is very helpful for me. But can you modify it to allow the user to make a selection on the part of drawing he want.

Thank you for everybody and you Tharwat.

Your code is very helpful for me. But can you modify it to allow the user to make a selection on the part of drawing he want.

You're welcome , and I am happy that you satisfied with my codes ..

In regard to your question , just remove the highlighted codes form the routine and everything would be OK .

........   (setq r 1)   (repeat (length Layers)    
(if (setq selectionset  (ssget  [color=red][b] "_x"[/b][/color]  (list  '(0 . "LINE,*POLYLINE,SPLINE,ARC")            
       (cons  8  (nth (setq increment (1+ increment)) layers))
.....................................

I have already done that but it call a number of selections equal to number of layers for example :"leyer1","layer2" so it make the selection 2 times in each time it filter the selection by the first layer then by the second layer.

I want filter the selection in one time

Thank you for everybody .

Guess i mis-understood your request then ..

Oh well.

I have already done that but it call a number of selections equal to number of layers for example :"leyer1","layer2" so it make the selection 2 times in each time it filter the selection by the first layer then by the second layer.

I want filter the selection in one time

You're right , I should change the way that the codes running to meet your new needs . which means more time to spend on the routine .

I have already done that but it call a number of selections equal to number of layers for example :"leyer1","layer2" so it make the selection 2 times in each time it filter the selection by the first layer then by the second layer.

I want filter the selection in one time

Can you run that by me again fathihvac?

I have already done that but it call a number of selections equal to number of layers for example :"leyer1","layer2" so it make the selection 2 times in each time it filter the selection by the first layer then by the second layer.

I want filter the selection in one time

Try it now with its much modifications on it to meet your needs

(defun c:Test (/ hgt e inc increment Layers insertionPoint tbl lengths
              lst result r selectionset integer selectionsetname
              entities i lays n
             )
 (vl-load-com)
;;; Tharwat 22 . May . 2012 ;;;
 (setq Layers '("Layer1" "Layer2" "Layer3"))
 (if (not acdoc)
   (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
 )
 (setq
   hgt (if
         (zerop
           (cdr
             (assoc
               40
               (setq
                 e (entget (tblobjname "STYLE" (getvar 'textstyle)))
               )
             )
           )
         )
          (cdr (assoc 42 e))
          (cdr (assoc 40 e))
       )
 )
 (setq increment -1
       r 1
 )
 (if (setq selectionset
            (ssget
              (list
                '(0 . "LINE,*POLYLINE,SPLINE,ARC")
                (cons 8
                      (vl-string-right-trim
                        ","
                        (apply
                          'strcat
                          (foreach x Layers
                            (setq lays (cons (strcat x ",") lays))
                          )
                        )
                      )
                )
              )
            )
     )
   (progn
     (repeat (setq integer (sslength selectionset))
       (setq
         entities (cons
                    (ssname selectionset (setq integer (1- integer)))
                    entities
                  )
       )
     )
     (foreach layer layers
       (setq i -1)
       (setq lengths 0)
       (repeat (length entities)
         (if
           (eq (cdr
                 (assoc 8
                        (entget (setq e (nth (setq i (1+ i)) entities)))
                 )
               )
               layer
           )
            (setq
              Lengths
               (+ (cond
                    ((eq (cdr (assoc 0 (entget e))) "LINE")
                     (distance (cdr (assoc 10 (entget e)))
                               (cdr (assoc 11 (entget e)))
                     )
                    )
                    ((eq (cdr (assoc 70 (entget e))) 1)
                     (vla-get-length (vlax-ename->vla-object e))
                    )
                    (t
                     (vlax-curve-getDistatPoint
                       e
                       (vlax-curve-getEndPoint e)
                     )
                    )
                  )
                  lengths
               )
            )
         )
       )
       (setq lst (cons (cons Layer lengths) lst))
     )
   )
 )
 (if selectionset
   (progn
     (foreach o (reverse lst)
       (if (not (eq (cdr o) 0))
         (setq result (cons o result))
       )
     )
     (setq insertionPoint (getpoint "\n Specify Table Location :"))
     (setq tbl (vla-addtable
                 (vla-get-modelspace acdoc)
                 (vlax-3d-point insertionPoint)
                 (+ (length result) 2)
                 2
                 (* hgt 2.5)
                 (* hgt 2.5)
               )
     )
     (setq inc -1)
     (repeat 2
       (vla-setcolumnwidth tbl 0 (* hgt 10.))
       (vla-setcolumnwidth tbl 1 (* hgt 10.))
       (vla-setrowheight tbl (setq inc (1+ inc)) (* hgt 2.5))
     )
     (vla-settext tbl 0 0 "\\C1;Length table")
     (vla-settext tbl 1 0 "\\C3;Layer")
     (vla-settext tbl 1 1 "\\C3;Length Total")
     (foreach x (reverse result)
       (vla-settext tbl (setq r (1+ r)) 0 (car x))
       (vla-setcellalignment tbl r 0 acMiddleCenter)
       (vla-settext tbl r 1 (rtos (cdr x) 2 4))
       (vla-setcellalignment tbl r 1 acMiddleCenter)
     )
   )
   (princ)
 )
 (princ "\n Written by Tharwat Al Shoufi")
 (princ)
)

Great job THARWAT.Thank you very much.

Great job THARWAT.Thank you very much.

You're welcome anytime Fathi .

I really happy that my codes worked as needed for you .

Tharwat

FWIW: I updated the code at post #3

(princ "\n Written by Tharwat Al Shoufi")

Thats your full name tharwat?

THANK YOU VERY MUTCH

pBe YOUR UPDATED CODE RUNS GREATLY.

 

Thats your full name tharwat?

Yup. I forgot to remove that , and I used to add it when routines being spread in the region only

@ Tharwat: Why even bother checking if the object is a line? Just use (vlax-curve-getDistAtParam (vlax-curve-getEndParam )) for all selected objects.