Length of Polyline

[Guest Peter31712]

HI,

 

How to use LISP to get the curve length of a polyline which already smoothed by the command "PEDIT" "FIT". Thank you

[David Bethel]

The basic engine could look like this:

 

  (setq ss nil)
 (while (or (not ss)
            (> (sslength ss) 1))
        (princ "\nSelect 1 PLINE")
        (setq ss (ssget '((0 . "*POLYLINE")))))
 (command "_.AREA" "_E" (ssname ss 0))
 (princ (strcat "\nPline Length = " (rtos (getvar "PERIMETER")) "\n"))

-David

[Guest Peter31712]

David

Thank you

[CADTutor]

Your request reminded me of a routine I wrote some time ago, so I rooted it out. It was written in 1995 so I needed to make some minor revisions, particularly to make it work with the new lightweight polylines.

 

At one time I was taking a lot of measurements off drawings for estimates and so I wrote a whole suite of commands for measuring, tagging and scheduling drawings. This is just a simple measuring routine that gives total length or area of all polylines on any specified layer. Layers are chosen by picking an object on that layer.

 

; Length/Area By Pline
;
; David Watson 1995 with minor revisions 2004
;
; This command will give a total area and/or length for all polylines on a specified layer.
;
;
(defun c:zone ( / ssl aret pert)
  (princ "\nPick any object on the required layer\n")
  (setq ssl (ssget))
  (if (= ssl nil)(princ "\n*** Nothing was selected! ***\n\n")
                 (progn
                    (setq lay (cdr (assoc 8 (entget (ssname ssl 0)))))
                    (setq ssl (ssget "X" (list (cons 8 lay))))
                    (princ (strcat "\nLayer " lay " selected"))
                    (initget "Length Area")
                    (setq res (getkword "\nWould you like to measure Length/<Area> : "))
                    (if (= res "Length")(mlen)(meas))
                 );end progn
  );end if
  (princ)
);END ZONE
(defun meas ()
  (setq len (sslength ssl))
  (setq alen (sslength ssl))
  (setq aret 0)
  (setq count 0)
  (setq nop 0)
  (setq ope 0)
  (while (/= len count)
     (setq pnt (ssname ssl count))
     (setq ple (cdr (assoc 0 (entget pnt))))
     (if (and (/= ple "LWPOLYLINE")(/= ple "POLYLINE"))
        (progn
           (setq nop (+ 1 nop))
           (setq alen (- alen 1))
           (princ "\nNon polyline filtered\n")
        );END PROGN
        (progn
           (setq plc (cdr (assoc 70 (entget pnt))))
           (if (= plc 0)
              (progn
                 (setq ope (+ 1 ope))
                 (princ "\nWarning! *** Polyline is not closed\n")
              );END PROGN
           );END IF
           (command "area" "e" pnt)
           (setq are (getvar "area"))
           (setq aret (+ are aret))
        );END PROGN
     );END IF
     (setq count (+ count 1))
  );END WHILE
  (if (= nop 0)(princ "\nAll selected objects were polylines")(princ (strcat "\n" (itoa nop) " non polyline objects were filtered")))
  (if (= ope 0)(princ "\nAll polylines were closed")(princ (strcat "\n" (itoa ope) " polylines were not closed")))
  (princ (strcat "\nTotal area for layer " lay " = " (rtos aret 2 2) " in " (itoa alen) " polylines"))
  (princ)
);END MEAS
(defun mlen ()
  (setq len (sslength ssl))
  (setq alen (sslength ssl))
  (setq pert 0)
  (setq count 0)
  (setq nop 0)
  (while (/= len count)
     (setq pnt (ssname ssl count))
     (setq ple (cdr (assoc 0 (entget pnt))))
     (if (and (/= ple "LWPOLYLINE")(/= ple "POLYLINE"))
        (progn
           (setq nop (+ 1 nop))
           (setq alen (- alen 1))
           (princ "\nNon polyline filtered\n")
        );END PROGN
        (progn
           (command "area" "e" pnt)
           (setq per (getvar "perimeter"))
           (setq pert (+ per pert))
        );END PROGN
     );END IF
     (setq count (+ count 1))
  );END WHILE
  (if (= nop 0)(princ "\nAll selected objects were polylines")(princ (strcat "\n" (itoa nop) " non polyline objects were filtered")))
  (princ (strcat "\nTotal length for layer " lay " = " (rtos pert 2 2) " in " (itoa alen) " polylines" ))
  (princ)
);END MLEN

I'm sure that David and fuccaro will have lots to criticise about the code but it does work

[David Bethel]

CADTutor,

 

If a program works, that's 90% of the goal.

 

In the old days with hardware limitations, speed of of evaluating the code was an issue. Not so anymore. At least with something realitivly small. I have a few programs that can take 3-4 minutes to execute, but we're dealing with maybe 100,000 faces.

 

Othe than working, the only thing I think that is important is that the author understand the code so that editing in the future can be easily done. Is it commented logocally if needed? Is it formatted so that the human eye and brain organize the code in the original intended manner.

 

Yes, you could probably use 75% less code, but does it matter if the thing works? -David

[CADTutor]

Yes, you could probably use 75% less code, but does it matter if the thing works?

 

You're right, of course. Originally, the two subroutines were used elsewhere in the suite and so were written seperately. Since I've done no LISPing in 9 years now, it might be a good test to see if I could rewrite this one and get the code down to just 25%. Somehow I doubt it. David, I've always admired the brevity of your code. I'd be interested to see just how small you could go with this one.

 

A challenge? Yes.

[David Bethel]

I'm up for a challenge from time to time.

 

;| Length/Area By Pline

 David Watson 1995 with minor revisions 2004

 This command will give a total area and/or length for all polylines on a specified layer.

 05-02-2004  Edited for CADTutuor

|;

(defun c:zone ( / ss la rv i tv op en)

  (while (not ss)
         (princ "\nPick any object on the required layer")
         (setq ss (ssget)))

  (initget "Length Area")
  (setq rv (getkword "\nWould you like to measure Length/<Area> : "))
  (and (not rv)
       (setq rv "Area"))

  (setq la (cdr (assoc 8 (entget (ssname ss 0))))
        ss (ssget "X" (list (cons 0 "*POLYLINE")
                            (cons 8 la)))
         i (sslength ss)
        tv 0
        op 0)
  (while (not (minusp (setq i (1- i))))
         (setq en (ssname ss i))
         (command "_.AREA" "_E" en)
         (cond ((= rv "Length")
                (setq tv (+ tv (getvar "PERIMETER"))))
               ((= (logand (cdr (assoc 70 (entget en))) 1) 1)
                (setq tv (+ tv (getvar "AREA"))))
               (T (setq op (1+ op)))))

  (princ (strcat "\nTotal " rv
                 " for layer " la
                 " = " (rtos tv 2 2)
                 " in " (itoa (- (sslength ss) op)) " polylines\n"
                 (if (/= rv "Length")
                     (strcat (itoa op) " open polylines dicarded") "")))
  (prin1))

Original posted code:

 

 

As posted:

 

 

Looks like 62% less code and 58% fewer statements. Looks like you had 15 global variables. That's a "no no".

 

-David

[CADTutor]

Well done David! That's very impressive.

 

Tell me, does "*POLYLINE" catch both "POLYLINE" and "LWPOLYLINE"? I haven't written any LISP since R14 so I wasn't exactly sure how to cover for both polyline types.

 

I notice that your routine differs functionally in one way - you do not include open polylines for the area calculation whereas my routine includes them but warns the user.

 

You're right about those global variables

[David Bethel]

CADTutor,

 

Yes, the "*" symbol is a wildcard. (ssget) filters comforms to (wcmatch) wildcard parameters. The draw back is that now someone can make a custom entity type that can be mistakenly included in the set but not conform to the groups dxf codes. It is a bad practice to name a custom entity type in that manner ( IMO ) i.e. RTEXT.

 

I missed the fact that you were including open plines. A small change is required.

 

-David

 

;| Length/Area By Pline

 David Watson 1995 with minor revisions 2004

 This command will give a total area and/or length for all polylines on a specified layer.

 05-02-2004  Edited for CADTutuor
 05-03-2004  Area To Include All Open And Closed PLINES

|;

(defun c:zone ( / ss la rv i tv op en)

  (while (not ss)
         (princ "\nPick any object on the required layer")
         (setq ss (ssget)))

  (initget "Length Area")
  (setq rv (getkword "\nWould you like to measure Length/<Area> : "))
  (and (not rv)
       (setq rv "Area"))

  (setq la (cdr (assoc 8 (entget (ssname ss 0))))
        ss (ssget "X" (list (cons 0 "*POLYLINE")
                            (cons 8 la)))
         i (sslength ss)
        tv 0
        op 0)
  (while (not (minusp (setq i (1- i))))
         (setq en (ssname ss i))
         (command "_.AREA" "_E" en)
         (cond ((= rv "Length")
                (setq tv (+ tv (getvar "PERIMETER"))))
               (T
                (setq tv (+ tv (getvar "AREA")))
                (if (/= (logand (cdr (assoc 70 (entget en))) 1) 1)
                    (setq op (1+ op))))))

  (princ (strcat "\nTotal " rv
                 " for layer " la
                 " = " (rtos tv 2 2)
                 " in " (itoa (sslength ss)) " polylines\n"
                 (if (/= rv "Length")
                     (strcat (itoa op) " with open polylines") "")))
  (prin1))

[CADTutor]

Thank you David. That has been a very useful little lesson for me (and for others I hope).

[fuccaro]

We assisted to a great discussion from man to man; from David to David. Will be the next one from Goliat to Goliat?

Now serious: interesting to see different solutions to the same problem...

[CADTutor]

Not sure if anyone round here would admit to being a Goliath (you fuccaro? )

 

It's true - as far as the user is concerned, my original routine and David's revised and superior routine appear identical. I hope that might be encouragement for everyone to have a go at a little bit of lisp.

 

As David said earlier in the topic, "If a program works, that's 90% of the goal."

[fuccaro]

Just a question: how to calculate the total area if two or more polylines are partially overlapping each other and we need the common area only once?

I don't expect a program at this point, I might just to start a discussion about how it would be possible...

[CADTutor]

I once wrote a routine that would subtract "islands" within larger areas but it would only work if the islands fell entirely within the larger area and the user had to select them in order to identify them.

 

I think the answer to your question requires a much higher degree of dificulty than I can manage. I suspect that the boundary command may be able to help here but I don't know how to harness it.

[David Bethel]

Yes, BOUNDARY could handle it. What an ugly mess to try and automate it. And if more than 1 pline overlapped, well.......

 

I'm not into solids, but maybe a single REGION could also be made of all of the plines. I guess there is some way to extract the area of one?

 

R12 doesn't have any of those thingys.

 

-David

[Solomon Levin]

Dear Sir,

I've test the LISP-Programm. It's cool. Thanks to all of Tuturs.

Granny Sol8)

[fuccaro]

This old thread returns to life after years!

Solomon Levin

People posting solutions in this forum are hapy to have feed-back from others. Thanks to you the two Davids will have a good day!

[Solomon Levin]

Я очень рад, что вы довольны.

Спасибо еще раз, что помогли старому дедушке.

I hope you understand Russian.

[CAB]

Here is another flavor to sample.

;;;=======================[ Length.lsp ]=========================
;;; Author: Copyright© 2005 Charles Alan Butler 
;;; Version:  1.0 July 12, 2005
;;; Purpose: display the length of a selected objects
;;;          and a running total
;;; Sub_Routines: -None 
;;; Returns: -NA  
;;;==============================================================
;|
I know there are many fine "Length" routines around.
This is my version and it allows the user to pick each object & displays
the length & a running total on the command line.
An option at start up lets the user optionally put the result in the drawing.
The text is placed at the user pick point and the current text style & layer are used.
The options for text insert are:
None - No text is inserted, this is the default
Each - Text is inserted after each object is selected
Total - Text is inserted only at the end of all selections & only the total is inserted.

Exit the routine by pressing Enter or picking nothing
Pressing C enter will clear the total
Pressing Enter while placing the text will skip the insert for that object.
|;
(defun c:length (/ en len pt txt ent_allowed total_len typ)
 (vl-load-com)
 (defun put_txt (txt / pt)
   ;;  Check if the drawing height is set to 0: 
   (if (setq pt (getpoint "\nPick Text Location..."))
     (if (= 0 (cdr (assoc 40
                        (tblsearch "style"
                                   (getvar "textstyle")))))
       (command "text" "non" pt "" "0" txt)
       (command "text" "non" pt "0" txt)
     ) ; endif
     (prompt "\n***  Text Insert skipped  ***")
   )
 )

 (initget "Each Total None" )
 (setq txt_opt (getkword "\nPut text in drawing for [Each/Total/None]. <None>"))
 (or txt_opt (setq txt_opt "None"))


 (setq ent_allowed '("LINE" "LWPOLYLINE" "POLYLINE" "SPLINE" "ARC" "CIRCLE")
       total_len   0
 )
 (while (or (initget "C")
            (setq en (entsel "\nPick object for length, C to clear total."))
        )
   (if (= "C" en)
     (progn
       (if (member txt_opt '("Each" "Total"))
         (put_txt (strcat "Total "(rtos total_len)))
       )
       (setq total_len 0) ; clear length total
     )
     (progn
       (setq en (car en))
       (if (member (setq typ (cdr (assoc 0 (entget en)))) ent_allowed)
         (progn
           (setq
             len (vlax-curve-getdistatparam en (vlax-curve-getendparam en))
           )
           (setq total_len (+ len total_len))
           (princ (strcat "\n"typ " length = " (rtos len)
                          "  Running total is " (rtos total_len))
           )
           (if (= txt_opt "Each") (put_txt (rtos len)))
         ) ; progn
         (alert "Not a valid object for length")
       )
     )
   )

 )
 (and (not (zerop total_len))
      (princ (strcat "\nTotal length is " (rtos total_len)))
      (if (member txt_opt '("Each" "Total"))
        (put_txt (strcat "Total "(rtos total_len)))
      )
 )
 (princ)
)
(prompt "\nGet Length loaded, Enter length to run")
(princ)

[Matt Schwartz]

We recently upgraded to Autocad Rel 2010.

Neither zone.lsp or tlen.lsp will run.

Any ideas?