Help? Total length on every Layer

[fathihvac]

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

Edited May 21, 2012 by fathihvac

[fixo]

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'~

[pBe]

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)

Edited May 22, 2012 by pBe
FWIW

[Tharwat]

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)
)

[Tharwat]

@pBe

 

Circles do not have the property Length neither ArcLength my friend

[pBe]

@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

[Tharwat]

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

 

thank you for reminding me

 

It's my pleasure

[fathihvac]

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.

[Tharwat]

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))
.....................................

[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

[pBe]

Thank you for everybody .

 

Guess i mis-understood your request then ..

 

Oh well.

[Tharwat]

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 .

[pBe]

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?

[Tharwat]

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)
)

[fathihvac]

Great job THARWAT.Thank you very much.

[Tharwat]

Great job THARWAT.Thank you very much.

 

You're welcome anytime Fathi .

 

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

 

Tharwat

[pBe]

FWIW: I updated the code at post #3

 

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

 

Thats your full name tharwat?

[fathihvac]

THANK YOU VERY MUTCH

pBe YOUR UPDATED CODE RUNS GREATLY.

[Tharwat]

 

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

[alanjt]

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