Jump to content

Help? Total length on every Layer


fathihvac

Recommended Posts

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 by fathihvac
Link to comment
Share on other sites

  • Replies 26
  • Created
  • Last Reply

Top Posters In This Topic

  • Tharwat

    11

  • fathihvac

    6

  • pBe

    5

  • alanjt

    2

Top Posters In This Topic

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

Link to comment
Share on other sites

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 by pBe
FWIW
Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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 .

Link to comment
Share on other sites

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? :unsure:

Link to comment
Share on other sites

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

Link to comment
Share on other sites

Great job THARWAT.Thank you very much.

 

You're welcome anytime Fathi .

 

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

 

Tharwat

Link to comment
Share on other sites

 

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 :lol:

Link to comment
Share on other sites

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

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...