Length of Polyline

Peter31712 · 30th Apr 2004 02:33 am

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** · 30th Apr 2004 01:49 pm

The basic engine could look like this:

Code:

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

-David

Peter31712 · 1st May 2004 02:38 am

David
Thank you

**CADTutor** · 1st May 2004 07:48 pm

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.

Code:

; 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.
;
;
&#40;defun c&#58;zone &#40; / ssl aret pert&#41;
   &#40;princ "\nPick any object on the required layer\n"&#41;
   &#40;setq ssl &#40;ssget&#41;&#41;
   &#40;if &#40;= ssl nil&#41;&#40;princ "\n*** Nothing was selected! ***\n\n"&#41;
                  &#40;progn
                     &#40;setq lay &#40;cdr &#40;assoc 8 &#40;entget &#40;ssname ssl 0&#41;&#41;&#41;&#41;&#41;
                     &#40;setq ssl &#40;ssget "X" &#40;list &#40;cons 8 lay&#41;&#41;&#41;&#41;
                     &#40;princ &#40;strcat "\nLayer " lay " selected"&#41;&#41;
                     &#40;initget "Length Area"&#41;
                     &#40;setq res &#40;getkword "\nWould you like to measure Length/<Area> &#58; "&#41;&#41;
                     &#40;if &#40;= res "Length"&#41;&#40;mlen&#41;&#40;meas&#41;&#41;
                  &#41;;end progn
   &#41;;end if
   &#40;princ&#41;
&#41;;END ZONE
&#40;defun meas &#40;&#41;
   &#40;setq len &#40;sslength ssl&#41;&#41;
   &#40;setq alen &#40;sslength ssl&#41;&#41;
   &#40;setq aret 0&#41;
   &#40;setq count 0&#41;
   &#40;setq nop 0&#41;
   &#40;setq ope 0&#41;
   &#40;while &#40;/= len count&#41;
      &#40;setq pnt &#40;ssname ssl count&#41;&#41;
      &#40;setq ple &#40;cdr &#40;assoc 0 &#40;entget pnt&#41;&#41;&#41;&#41;
      &#40;if &#40;and &#40;/= ple "LWPOLYLINE"&#41;&#40;/= ple "POLYLINE"&#41;&#41;
         &#40;progn
            &#40;setq nop &#40;+ 1 nop&#41;&#41;
            &#40;setq alen &#40;- alen 1&#41;&#41;
            &#40;princ "\nNon polyline filtered\n"&#41;
         &#41;;END PROGN
         &#40;progn
            &#40;setq plc &#40;cdr &#40;assoc 70 &#40;entget pnt&#41;&#41;&#41;&#41;
            &#40;if &#40;= plc 0&#41;
               &#40;progn
                  &#40;setq ope &#40;+ 1 ope&#41;&#41;
                  &#40;princ "\nWarning! *** Polyline is not closed\n"&#41;
               &#41;;END PROGN
            &#41;;END IF
            &#40;command "area" "e" pnt&#41;
            &#40;setq are &#40;getvar "area"&#41;&#41;
            &#40;setq aret &#40;+ are aret&#41;&#41;
         &#41;;END PROGN
      &#41;;END IF
      &#40;setq count &#40;+ count 1&#41;&#41;
   &#41;;END WHILE
   &#40;if &#40;= nop 0&#41;&#40;princ "\nAll selected objects were polylines"&#41;&#40;princ &#40;strcat "\n" &#40;itoa nop&#41; " non polyline objects were filtered"&#41;&#41;&#41;
   &#40;if &#40;= ope 0&#41;&#40;princ "\nAll polylines were closed"&#41;&#40;princ &#40;strcat "\n" &#40;itoa ope&#41; " polylines were not closed"&#41;&#41;&#41;
   &#40;princ &#40;strcat "\nTotal area for layer " lay " = " &#40;rtos aret 2 2&#41; " in " &#40;itoa alen&#41; " polylines"&#41;&#41;
   &#40;princ&#41;
&#41;;END MEAS
&#40;defun mlen &#40;&#41;
   &#40;setq len &#40;sslength ssl&#41;&#41;
   &#40;setq alen &#40;sslength ssl&#41;&#41;
   &#40;setq pert 0&#41;
   &#40;setq count 0&#41;
   &#40;setq nop 0&#41;
   &#40;while &#40;/= len count&#41;
      &#40;setq pnt &#40;ssname ssl count&#41;&#41;
      &#40;setq ple &#40;cdr &#40;assoc 0 &#40;entget pnt&#41;&#41;&#41;&#41;
      &#40;if &#40;and &#40;/= ple "LWPOLYLINE"&#41;&#40;/= ple "POLYLINE"&#41;&#41;
         &#40;progn
            &#40;setq nop &#40;+ 1 nop&#41;&#41;
            &#40;setq alen &#40;- alen 1&#41;&#41;
            &#40;princ "\nNon polyline filtered\n"&#41;
         &#41;;END PROGN
         &#40;progn
            &#40;command "area" "e" pnt&#41;
            &#40;setq per &#40;getvar "perimeter"&#41;&#41;
            &#40;setq pert &#40;+ per pert&#41;&#41;
         &#41;;END PROGN
      &#41;;END IF
      &#40;setq count &#40;+ count 1&#41;&#41;
   &#41;;END WHILE
   &#40;if &#40;= nop 0&#41;&#40;princ "\nAll selected objects were polylines"&#41;&#40;princ &#40;strcat "\n" &#40;itoa nop&#41; " non polyline objects were filtered"&#41;&#41;&#41;
   &#40;princ &#40;strcat "\nTotal length for layer " lay " = " &#40;rtos pert 2 2&#41; " in " &#40;itoa alen&#41; " polylines" &#41;&#41;
   &#40;princ&#41;
&#41;;END MLEN

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

**David Bethel** · 2nd May 2004 01:50 pm

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** · 2nd May 2004 06:53 pm

Originally Posted by David Bethel

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** · 2nd May 2004 10:25 pm

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

Code:

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

|;

&#40;defun c&#58;zone &#40; / ss la rv i tv op en&#41;

   &#40;while &#40;not ss&#41;
          &#40;princ "\nPick any object on the required layer"&#41;
          &#40;setq ss &#40;ssget&#41;&#41;&#41;

   &#40;initget "Length Area"&#41;
   &#40;setq rv &#40;getkword "\nWould you like to measure Length/<Area> &#58; "&#41;&#41;
   &#40;and &#40;not rv&#41;
        &#40;setq rv "Area"&#41;&#41;

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

   &#40;princ &#40;strcat "\nTotal " rv
                  " for layer " la
                  " = " &#40;rtos tv 2 2&#41;
                  " in " &#40;itoa &#40;- &#40;sslength ss&#41; op&#41;&#41; " polylines\n"
                  &#40;if &#40;/= rv "Length"&#41;
                      &#40;strcat &#40;itoa op&#41; " open polylines dicarded"&#41; ""&#41;&#41;&#41;
   &#40;prin1&#41;&#41;

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** · 2nd May 2004 11:27 pm

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** · 3rd May 2004 01:43 pm

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

Code:

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

|;

&#40;defun c&#58;zone &#40; / ss la rv i tv op en&#41;

   &#40;while &#40;not ss&#41;
          &#40;princ "\nPick any object on the required layer"&#41;
          &#40;setq ss &#40;ssget&#41;&#41;&#41;

   &#40;initget "Length Area"&#41;
   &#40;setq rv &#40;getkword "\nWould you like to measure Length/<Area> &#58; "&#41;&#41;
   &#40;and &#40;not rv&#41;
        &#40;setq rv "Area"&#41;&#41;

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

   &#40;princ &#40;strcat "\nTotal " rv
                  " for layer " la
                  " = " &#40;rtos tv 2 2&#41;
                  " in " &#40;itoa &#40;sslength ss&#41;&#41; " polylines\n"
                  &#40;if &#40;/= rv "Length"&#41;
                      &#40;strcat &#40;itoa op&#41; " with open polylines"&#41; ""&#41;&#41;&#41;
   &#40;prin1&#41;&#41;

**CADTutor** · 3rd May 2004 02:46 pm

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

Thread: Length of Polyline

Thread Tools

Length of Polyline

David Bethel's Discipline Details

CADTutor's Computer Details

CADTutor's Discipline Details

David Bethel's Discipline Details

CADTutor's Computer Details

CADTutor's Discipline Details

David Bethel's Discipline Details

CADTutor's Computer Details

CADTutor's Discipline Details

David Bethel's Discipline Details

CADTutor's Computer Details

CADTutor's Discipline Details

Bookmarks

Bookmarks

Posting Permissions