Topic: Total Length of (user selected) Polylines

[DaddyChris]

Hey everyone!

I have been dealing with this issue for quite some time and cannot seem to figure it out. I have thought about maybe having a Lisp receive the user selected polylines, then dumping the info of them and sending it to DIESEL and retrieving the calculated numbers from DIESEL and spitting it out to the user in an alert but i can't seem to get it to work since I am unable to run any VLAX code. 

So, is there any way such as a workaround or a different route to take that can be used instead of the VLAX in the code below.. (Copy and pasted from an old post)

Uhh?... should look like this:

Code: [Select]

(defun C:PolyLength ( / CurEnt CurLgt CurSet EntCnt TmpLgt TmpVal)
(setq CurSet (ssget '((0 . "LWPOLYLINE,POLYLINE") (410 . "Model")))
       EntCnt 0
       CurLgt 0.0
)
(if CurSet
  (while (< EntCnt (sslength CurSet))
   (setq CurEnt (ssname CurSet EntCnt)
         TmpVal (vlax-curve-getEndParam CurEnt)
         TmpLgt (vlax-curve-getDistAtParam CurEnt TmpVal)
         CurLgt (+ CurLgt TmpLgt)
         EntCnt (1+ EntCnt)
   )
  )
)
(alert
  (strcat
   (itoa (sslength CurSet)) " Polylines found"
   " with a total length of " (rtos CurLgt) " units."
  )
)
(princ)
)

[ronjonp]

Maybe this? BTW .. welcome to TheSwamp

Code - Auto/Visual Lisp: [Select]

1. ;   Length/Area of Polyline by Layer
2. ;   David Bethel May 2004 from an original idea by David Watson
3. ;   This command will give a total area or length for all polylines on a specified layer.
4. ;
5. (defun c:zone ( / ss la rv i tv op en)
6.  
7.  
8.    (while (not ss)
9.           (princ "\nPick any object on the required layer")
10.           (setq ss (ssget)))
11.  
12.  
13.    (initget "Length Area")
14.    (setq rv (getkword "\nWould you like to measure Length/<Area> : "))
15.    (and (not rv)
16.         (setq rv "Area"))
17.  
18.  
19.    (setq la (cdr (assoc 8 (entget (ssname ss 0))))
20.          ss (ssget "X" (list (cons 0 "*POLYLINE")
21.                              (cons 8 la)))
22.           i (sslength ss)
23.          tv 0
24.          op 0)
25.    (while (not (minusp (setq i (1- i))))
26.           (setq en (ssname ss i))
27.           (command "_.AREA" "_E" en)
28.           (cond ((= rv "Length")
29.                  (setq tv (+ tv (getvar "PERIMETER"))))
30.                 (T
31.                  (setq tv (+ tv (getvar "AREA")))
32.                  (if (/= (logand (cdr (assoc 70 (entget en))) 1) 1)
33.                      (setq op (1+ op))))))
34.  
35.  
36.    (princ (strcat "\nTotal " rv
37.                   " for layer " la
38.                   " = " (rtos tv 2 2)
39.                   " in " (itoa (sslength ss)) " polylines\n"
40.                   (if (/= rv "Length")
41.                       (strcat (itoa op) " with open polylines") "")))
42.    (prin1))

[ChrisCarlson]

Are you sure it's because you are not initiating VLAX with (vl-load-com)?

Try this routine
http://www.lee-mac.com/totallengthandarea.html

Code - Auto/Visual Lisp: [Select]

1. ;;--------------------=={ Total Length }==--------------------;;
2. ;;                                                            ;;
3. ;;  Displays the total length of selected objects at the      ;;
4. ;;  command line. The units and precision format of the       ;;
5. ;;  printed result is dependent upon the settings of the      ;;
6. ;;  LUNITS & LUPREC system variables respectively.            ;;
7. ;;------------------------------------------------------------;;
8. ;;  Author: Lee Mac, Copyright © 2013 - www.lee-mac.com       ;;
9. ;;------------------------------------------------------------;;
10.  
11. (defun c:tlen ( / e i l s )
12.     (if (setq s
13.             (ssget
14.                '(   (0 . "ARC,CIRCLE,ELLIPSE,LINE,*POLYLINE,SPLINE")
15.                     (-4 . "<NOT")
16.                         (-4 . "<AND")
17.                             (0 . "POLYLINE") (-4 . "&") (70 . 80)
18.                         (-4 . "AND>")
19.                     (-4 . "NOT>")
20.                 )
21.             )
22.         )
23.         (progn
24.             (setq l 0.0)
25.             (repeat (setq i (sslength s))
26.                 (setq e (ssname s (setq i (1- i)))
27.                       l (+ l (vlax-curve-getdistatparam e (vlax-curve-getendparam e)))
28.                 )
29.             )
30.             (princ "\nTotal Length: ")
31.             (princ (rtos l))
32.         )
33.     )
34.     (princ)
35. )
36. (vl-load-com) (princ)

[BlackBox]

I work in Civil design, so I end up needing more level of detail.

Cheers


AddLength - supports Arcs, Lines, Polylines, and Civil 3D Pipes:

Code - Auto/Visual Lisp: [Select]

1. (defun c:AddLength (/ *error* ss l p)
2.  
3.   (defun *error* (msg)
4.     (if ss (vla-delete ss))
5.     (cond ((not msg))                                                   ; Normal exit
6.           ((member msg '("Function cancelled" "quit / exit abort")))    ; <esc> or (quit)
7.           ((princ (strcat "\n** Error: " msg " ** ")))                  ; Fatal error, display it
8.     )
9.     (princ)
10.   )
11.  
12.   (if (ssget "_:L" '((0 . "AECC_PIPE,ARC,LINE,*POLYLINE")))
13.     (progn
14.       (vlax-for x (setq ss (vla-get-activeselectionset acDoc))
15.         (cond
16.           ((= "AeccDbPipe" (vla-get-objectname x))
17.            ;;<-- to do: tally each pipe size individually - by 'InnerHeight property?
18.            (setq p (cons (vlax-get x 'length2d) p))
19.           )
20.           ((setq l
21.                   (cons
22.                     (vlax-get x
23.                               (if (= "AcDbArc" (vla-get-objectname x))
24.                                 'arclength
25.                                 'length
26.                               )
27.                     )
28.                     l
29.                   )
30.            )
31.           )
32.         )
33.       )
34.       (if p
35.         (prompt (strcat "\nTotal pipe length: "
36.                         (rtos (setq p (apply '+ p)) 2 2)
37.                         " LF | "
38.                         (rtos (/ p 3.0) 2 2)
39.                         " LY | "
40.                         (rtos (/ p 5280.0) 2 2)
41.                         " MI "
42.                 )
43.         )
44.       )
45.       (if l
46.         (prompt (strcat "\nTotal length: "
47.                         (rtos (setq l (apply '+ l)) 2 2)
48.                         " LF | "
49.                         (rtos (/ l 3.0) 2 2)
50.                         " LY | "
51.                         (rtos (/ l 5280.0) 2 2)
52.                         " MI "
53.                 )
54.         )
55.       )
56.     )
57.   )
58.   (*error* nil)
59. )
60.  

AddArea - supports Circles, Hatch, and Polylines:

Code - Auto/Visual Lisp: [Select]

1. (defun c:AddArea (/ *error* ss area)
2.  
3.   (defun *error* (msg)
4.     (if ss (vla-delete ss))
5.     (cond ((not msg))                                                   ; Normal exit
6.           ((member msg '("Function cancelled" "quit / exit abort")))    ; <esc> or (quit)
7.           ((princ (strcat "\n** Error: " msg " ** ")))                  ; Fatal error, display it
8.     )
9.     (princ)
10.   )
11.  
12.   (if (ssget '((0 . "CIRCLE,HATCH,*POLYLINE")))
13.     (progn
14.       (vlax-for x (setq ss (vla-get-activeselectionset acDoc))
15.         (setq area (cons (vla-get-area x) area))
16.       )
17.       (prompt (strcat "\nTotal area: "
18.                       (rtos (setq area (apply '+ area)) 2 2)
19.                       " SF | "
20.                       (rtos (/ area 9.0) 2 2)
21.                       " SY | "
22.                       (rtos (/ area 43560.0) 2 2)
23.                       " AC "
24.               )
25.       )
26.     )
27.   )
28.   (*error* nil)
29. )
30.