TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: jav on August 30, 2007, 06:10:38 PM

Title: Total distance (ARC,LINE,LWPOLYLINE,POLYLINE) by layer
Post by: jav on August 30, 2007, 06:10:38 PM
Is there a routine out there anywhere that will list the total length of a group of lines that are on the same layer?

For example if we layout a bunch of pipe 3/4" dia. on one layer and more pipe, say 1 1/4", on another layer, it would be great if you could get the total length of pipe for each layer.
Thanks for any help.
Title: Re: Total distance (ARC,LINE,LWPOLYLINE,POLYLINE) by layer
Post by: ronjonp on August 30, 2007, 07:35:16 PM
Give this a try:

Code: [Select]
(defun c:totalen (/ total lay ss lst output)
  (setq total 0
lay   (cdr
(assoc
  8
  (entget
    (car (entsel "\n Select object to set layer filter: "))
  )
)
      )
ss    (ssget (list (cons '0 "LINE,*POLYLINE,SPLINE,ARC,CIRCLE")
   (cons '8 lay)
     )
      )
  )
  (if (and lay ss)
    (progn
      (setq
lst (mapcar 'vlax-ename->vla-object
    (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
    )
      )
      (mapcar '(lambda (x)
(setq len   (vlax-curve-getdistatparam
       x
       (vlax-curve-getendparam x)
     )
       total (+ total len)
)
       )
      lst
      )
      (setq output
     (strcat "\n"
     (itoa (sslength ss))
     " objects on layer ''"
     lay
     "'' have a total length of  -  "
     (rtos total (getvar 'lunits) 3)
     )
      )
      (alert output)
      (princ output)
    )
  )
)
Title: Re: Total distance (ARC,LINE,LWPOLYLINE,POLYLINE) by layer
Post by: jav on August 31, 2007, 05:25:13 PM
Thanks very much ronjonp
Title: Re: Total distance (ARC,LINE,LWPOLYLINE,POLYLINE) by layer
Post by: ronjonp on August 31, 2007, 10:55:48 PM
You're welcome  :-)
Title: Re: Total distance (ARC,LINE,LWPOLYLINE,POLYLINE) by layer
Post by: VVA on September 04, 2007, 01:50:59 AM
Count on all layers taking into account correction factor
Code: [Select]
(defun c:mlen (/ m ss clist temp)
  (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 mlen3_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))
      )
    )
  )
  (vl-load-com)
  (and
    (if (null (setq m (getreal "\nEnter correction factor <1>:\t")))
      (setq m 1) t)
    (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\nTotal length by layer:"
    )
    (mapcar 'mlen3_1 clist)
  )
  (princ)
) ;_  defun