Author Topic: Sum of length of different diameter pipes (Read 4891 times)

tanvirme2k9 · « **on:** February 26, 2016, 12:46:39 PM »

Hi All,

I am interesting in a lisp which will sum up the pipe lengths of different diameters.Then make a table of total pipe length according to diameters and count number of times the same diameter is used. I am attaching drawing for reference. Is it possible?

mjfarrell · « **Reply #1 on:** February 26, 2016, 01:19:45 PM »

do you use MAP or Civil 3d?

IF yes, then yes with a simple MAP Query

otherwise....you're stuck with LISP or other solution

mjfarrell · « **Reply #2 on:** February 26, 2016, 01:22:05 PM »

actually seeing all your data on layer "test" then not with a query until you put those 'pipes' on unique pipe size layers, or embed some object data

at this point they are just dumb cad lines and not much use....for MAP

ChrisCarlson · « **Reply #3 on:** February 26, 2016, 01:30:44 PM »

As-is no, split up layers and use a simple line counter routine.

Code - Auto/Visual Lisp: [Select]

;;--------------------=={ Total Length }==--------------------;;
;;                                                            ;;
;;  Displays the total length of selected objects at the      ;;
;;  command line. The units and precision format of the       ;;
;;  printed result is dependent upon the settings of the      ;;
;;  LUNITS & LUPREC system variables respectively.            ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2013 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
 
(defun c:tlen ( / e i l s )
    (if (setq s
            (ssget
               '(   (0 . "ARC,CIRCLE,ELLIPSE,LINE,*POLYLINE,SPLINE")
                    (-4 . "<NOT")
                        (-4 . "<AND")
                            (0 . "POLYLINE") (-4 . "&") (70 . 80)
                        (-4 . "AND>")
                    (-4 . "NOT>")
                )
            )
        )
        (progn
            (setq l 0.0)
            (repeat (setq i (sslength s))
                (setq e (ssname s (setq i (1- i)))
                      l (+ l (vlax-curve-getdistatparam e (vlax-curve-getendparam e)))
                )
            )
            (princ "\nTotal Length: ")
            (princ (rtos l))
        )
    )
    (princ)
)
(vl-load-com) (princ)

tanvirme2k9 · « **Reply #4 on:** February 26, 2016, 01:33:01 PM »

Mjfarrell, I am using Autocad 2016. Oh.. sorry! the lines,blocks and dia, all will be in different layers

ChrisCarlson, Thanks for your reply, I use this routine for different purpose. But here I am wanting total length with respect to diameter, separated by blocks.

HasanCAD · « **Reply #5 on:** February 27, 2016, 01:53:41 AM »

This lisp calculate per layer and show data on excel may helps
this lisp is not mine and I did not remember either from where I got or the coder.

Code - Auto/Visual Lisp: [Select]

(defun c:mlen (/ m ss clist temp xls sort combine mlen4_1)
  (defun sort (lst predicate)
    (mapcar '(lambda (x) (nth x lst)) (vl-sort-i lst predicate))
  )
  (defun combine (inlist is-greater is-equal / sorted current result)
    (setq sorted (sort inlist is-greater))
    (setq current (list (car sorted)))
    (foreach item (cdr sorted)
      (if (apply is-equal (list item (car current)))
        (setq current (cons item current))
        (progn
          (setq result (cons current result))
          (setq current (list item))
        )
      )
    )
    (cons current result)
  )
  (defun xls (Data-list      header         Colhide
              Name_list      /              *aplexcel*
              *books-colection*             Currsep
              *excell-cells* *new-book*     *sheet#1*
              *sheet-collection*            col
              iz_listo       row            cell
              cols
             )
    (defun Letter (N / Res TMP)
      (setq Res "")
      (while (> N 0)
        (setq TMP (rem N 26)
              TMP (if (zerop TMP)
                    (setq N   (1- N)
                          TMP 26
                    )
                    TMP
                  )
              Res (strcat (chr (+ 64 TMP)) Res)
              N   (/ N 26)
        )
      )
      Res
    )
    (if (null Name_list)
      (setq Name_list "")
    )
    (setq *AplExcel* (vlax-get-or-create-object "Excel.Application"))
    (if (setq *New-Book* (vlax-get-property *AplExcel* "ActiveWorkbook"))
      (setq *Books-Colection*  (vlax-get-property *AplExcel* "Workbooks")
            *Sheet-Collection* (vlax-get-property *New-Book* "Sheets")
            *Sheet#1*          (vlax-invoke-method *Sheet-Collection* "Add")
      )
      (setq *Books-Colection*  (vlax-get-property *AplExcel* "Workbooks")
            *New-Book*         (vlax-invoke-method *Books-Colection* "Add")
            *Sheet-Collection* (vlax-get-property *New-Book* "Sheets")
            *Sheet#1*          (vlax-get-property *Sheet-Collection* "Item" 1)
      )
    )
    (setq *excell-cells* (vlax-get-property *Sheet#1* "Cells"))
    (setq Name_list (if (= Name_list "")
                      (vl-filename-base (getvar "DWGNAME"))
                      (strcat (vl-filename-base (getvar "DWGNAME"))
                              "&"
                              Name_list
                      )
                    )
          col       0
          cols      nil
    )
    (if (> (strlen Name_list) 26)
      (setq Name_list
             (strcat (substr Name_list 1 10)
                     "..."
                     (substr Name_list (- (strlen Name_list) 13) 14)
             )
      )
    )
    (vlax-for sh *Sheet-Collection*
      (setq cols (cons (strcase (vlax-get-property sh 'Name)) cols))
    )
    (setq row Name_list)
    (while (member (strcase row) cols)
      (setq row (strcat Name_list " (" (itoa (setq col (1+ col))) ")"))
    )
    (setq Name_list row)
    (vlax-put-property *Sheet#1* 'Name Name_list)
    (setq Currsep (vlax-get-property *AplExcel* "UseSystemSeparators"))
    (vlax-put-property
      *AplExcel*
      "UseSystemSeparators"
      :vlax-false
    ) ;_?? ???????????? ????????? ?????????
    (vlax-put-property *AplExcel* "DecimalSeparator" ".") ;_??????????? ??????? ? ????? ?????
    (vlax-put-property *AplExcel* "ThousandsSeparator" " ") ;_??????????? ???????
    (vla-put-visible *AplExcel* :vlax-true)
    (setq row 1
          col 1
    )
    (if (null header)
      (setq header '("X" "Y" "Z"))
    )
    (repeat (length header)
      (vlax-put-property
        *excell-cells*
        "Item"
        row
        col
        (vl-princ-to-string (nth (1- col) header))
      )
      (setq col (1+ col))
    )
    (setq row 2
          col 1
    )
    (repeat (length Data-list)
      (setq iz_listo (car Data-list))
      (repeat (length iz_listo)
        (vlax-put-property
          *excell-cells*
          "Item"
          row
          col
          (vl-princ-to-string (car iz_listo))
        )
        (setq iz_listo (cdr iz_listo)
              col      (1+ col)
        )
      )
      (setq Data-list (cdr Data-list))
      (setq col 1
            row (1+ row)
      )
    )
    (setq col (1+ (length header))
          row (1+ row)
    )
    (setq cell (vlax-variant-value
                 (vlax-invoke-method
                   *Sheet#1*
                   "Evaluate"
                   (strcat "A1:" (letter col) (itoa row))
                 )
               )
    ) ;_ end of setq
    (setq cols (vlax-get-property cell 'Columns))
    (vlax-invoke-method cols 'Autofit)
    (vlax-release-object cols)
    (vlax-release-object cell)
    (foreach item ColHide
      (if (numberp item)
        (setq item (letter item))
      )
      (setq cell (vlax-variant-value
                   (vlax-invoke-method
                     *Sheet#1*
                     "Evaluate"
                     (strcat item "1:" item "1")
                   )
                 )
      )
      (setq cols (vlax-get-property cell 'Columns))
      (vlax-put-property cols 'hidden 1)
      (vlax-release-object cols)
      (vlax-release-object cell)
    )
    (vlax-put-property *AplExcel* "UseSystemSeparators" Currsep)
    (mapcar 'vlax-release-object
            (list *excell-cells*      *Sheet#1*
                  *Sheet-Collection*  *New-Book*
                  *Books-Colection*   *AplExcel*
                 )
    )
    (setq *AplExcel* nil)
    (gc)
    (gc)
    (princ)
  )
  (defun mlen4_1 (lst / sum_len)
    (setq sum_len 0)
    (foreach item (mapcar 'car lst)
      (setq
        sum_len (+ sum_len
                   (if (vlax-property-available-p item 'length)
                     (vla-get-length item)
                     (cond
                       ((=
                          (strcase (vla-get-objectname item) t)
                          "acdbarc"
                        ) ;_  =
                        (vla-get-arclength item)
                       )
                       ((=
                          (strcase (vla-get-objectname item) t)
                          "acbcircle"
                        ) ;_  =
                        (* pi 2.0 (vla-get-radius item))
                       )
                       (t 0.0)
                     ) ;_  cond
                   ) ;_  if
                ) ;_  +
      )
    )
    (if (not (zerop sum_len))
      (princ
        (strcat "\n\t" (cdar lst) " = " (rtos (* sum_len m) 2 4))
      )
    )
    (list (cdar lst) (rtos (* sum_len m) 2 4))
  )
  (vl-load-com)
  (if (null *M*)
    (setq *M* 1)
  )
  (initget 6)
  (and
    (princ "\nEnter scale factor <")
    (princ *M*)
    (princ ">: ")
    (or (setq m (getreal))
        (setq m *M*)
    )
    (setq *M* m)
    (setq ss (ssget "_:L"))
    (setq ss (mapcar
               (function vlax-ename->vla-object)
               (vl-remove-if
                 (function listp)
                 (mapcar
                   (function cadr)
                   (ssnamex ss)
                 ) ;_  mapcar
               ) ;_ vl-remove-if
             )
    )
    (mapcar '(lambda (x)
               (setq temp (cons (cons x (vla-get-Layer x)) temp))
             )
            ss
    )
    (setq clist (combine temp
                         '(lambda (a b)
                            (> (cdr a) (cdr b))
                          )
                         '(lambda (a b)
                            (eq (cdr a) (cdr b))
                          )
                )
    )
    (princ
      "\n\n  The total length of all line primitives by layers:"
    )
    (setq temp (mapcar 'mlen4_1 clist))
    (xls temp '("Layer" "Length") nil "mlen41")
  )
  (princ)
) ;_  defun

tanvirme2k9 · « **Reply #6 on:** February 27, 2016, 04:22:28 AM »

Thanks Mr. Hasan.But it's very difficult to connect over thousands of blocks with different layered lines

tanvirme2k9 · « **Reply #7 on:** March 03, 2016, 11:53:04 PM »

Anyone?

dgorsman · « **Reply #8 on:** March 07, 2016, 02:00:45 PM »

The more automated the process is, the more consistent the data must be. If you cannot guarantee consistency across your data the process cannot be readily automated.

tanvirme2k9 · « **Reply #9 on:** March 08, 2016, 09:40:11 AM »

dgorsman, the data is consistent

dgorsman · « **Reply #10 on:** March 08, 2016, 10:14:38 AM »

Quote from: tanvirme2k9 on February 27, 2016, 04:22:28 AM

Thanks Mr. Hasan.But it's very difficult to connect over thousands of blocks with different layered lines

Would seem to indicate otherwise.

ronjonp · « **Reply #11 on:** March 08, 2016, 03:27:16 PM »

This should help break up the segments into layers .. only works with lines on layer 'test' your block 'b' & text items that match '%%C*'. Each segment has to have a label associated with it.

Code - Auto/Visual Lisp: [Select]

(defun c:bazinga (/ _dxf _unq clr f fz i o p pts pts2 sp ss)
  (defun _dxf (code ename)
    (if   (and ename (= (type ename) 'ename))
      (cdr (assoc code (entget ename '("*"))))
    )
  )
  (defun _unq (i l f) (null (vl-some (function (lambda (x) (equal i x f))) l)))
  (setq fz 0.5)
  (if (setq ss (ssget "_x"
            (list '(-4 . "<OR")    '(-4 . "<AND")         '(0 . "insert")
             '(2 . "b")       '(-4 . "AND>")         '(-4 . "<AND")
             '(0 . "line")    '(8 . "test")         '(-4 . "AND>")
             '(-4 . "<AND")    '(0 . "text")         '(1 . "`%`%C*")
             '(-4 . "AND>")    '(-4 . "OR>")
            )
          )
      )
    (progn (foreach x (mapcar 'cadr (ssnamex ss))
        (cond ((= "INSERT" (_dxf 0 x))
          (if   (_unq (setq p (_dxf 10 x)) pts fz)
            (setq pts (cons p pts))
          )
         )
         ((= "LINE" (_dxf 0 x))
          (if   (_unq (setq p (_dxf 10 x)) pts fz)
            (setq pts (cons p pts))
          )
          (if   (_unq (setq p (_dxf 11 x)) pts fz)
            (setq pts (cons p pts))
          )
         )
         ((= "TEXT" (_dxf 0 x))
          (if   (_unq (setq p (list (_dxf 10 x) (_dxf 1 x))) pts2 fz)
            (setq pts2 (cons p pts2))
          )
         )
        )
      )
      (foreach x pts2
        (setq p (car x))
        (setq sp (vl-sort pts (function (lambda (a b) (< (distance p a) (distance p b))))))
        (if (<= (setq clr (atoi (substr (cadr x) 4))) 0)
          (setq clr 256)
        )
        (entmakex (list '(0 . "LWPOLYLINE")
              '(100 . "AcDbEntity")
              (cons 8 (vl-princ-to-string (atof (substr (cadr x) 4))))
              (cons 62 clr)
              '(100 . "AcDbPolyline")
              '(90 . 2)
              (cons 43 6.0)
              (cons 10 (car sp))
              (cons 10 (cadr sp))
             )
        )
      )
    )
  )
  (princ)
)

tanvirme2k9 · « **Reply #12 on:** March 09, 2016, 06:45:56 AM »

Not working in my work drawing

Please see attached.

ronjonp · « **Reply #13 on:** March 09, 2016, 08:54:15 AM »

Well full circle .. it's because your data is not consistent.

If you draw your map using just LINES, place your labels at the midpoint of the ends of your segment & be consistent with OSNAPS, you'd get decent results.

tanvirme2k9 · « **Reply #14 on:** March 09, 2016, 11:51:54 AM »

Yoo bro, inconsitent

Thanks a lot

, though not 100% but it worked great!!

News:

Author Topic: Sum of length of different diameter pipes (Read 4891 times)

tanvirme2k9

Sum of length of different diameter pipes

mjfarrell

Re: Sum of length of different diameter pipes

mjfarrell

Re: Sum of length of different diameter pipes

ChrisCarlson

Re: Sum of length of different diameter pipes

tanvirme2k9

Re: Sum of length of different diameter pipes

HasanCAD

Re: Sum of length of different diameter pipes

tanvirme2k9

Re: Sum of length of different diameter pipes

tanvirme2k9

Re: Sum of length of different diameter pipes

dgorsman

Re: Sum of length of different diameter pipes

tanvirme2k9

Re: Sum of length of different diameter pipes

dgorsman

Re: Sum of length of different diameter pipes

ronjonp

Re: Sum of length of different diameter pipes

tanvirme2k9

Re: Sum of length of different diameter pipes

ronjonp

Re: Sum of length of different diameter pipes

tanvirme2k9

Re: Sum of length of different diameter pipes