PDA

View Full Version : 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:

&#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

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.

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

David Bethel
2nd May 2004, 01:50 pm

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

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

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

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 :oops:

David Bethel
3rd May 2004, 01:43 pm

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

3rd May 2004, 02:46 pm
Thank you David. That has been a very useful little lesson for me (and for others I hope).

fuccaro
3rd May 2004, 02:50 pm
We assisted to a great discussion from man to man; from David to David. Will be the next one from Goliat to Goliat? :D
Now serious: interesting to see different solutions to the same problem...

3rd May 2004, 02:59 pm
Not sure if anyone round here would admit to being a Goliath (you fuccaro? :lol: )

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
5th May 2004, 08:31 am
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...

5th May 2004, 09:19 am
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
5th May 2004, 01:29 pm
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. <g>

-David

Solomon Levin
14th Jan 2008, 04:03 pm
Dear Sir,
I've test the LISP-Programm. It's cool. Thanks to all of Tuturs.
Granny Sol8)

fuccaro
14th Jan 2008, 08:25 pm
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
18th Jan 2008, 03:22 pm
Я очень рад, что вы довольны.
Спасибо еще раз, что помогли старому дедушке.
I hope you understand Russian.

CAB
19th Jan 2008, 02:11 pm
Here is another flavor to sample.:)

;;;=======================[ Length.lsp ]=========================
;;; 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)
(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
31st Mar 2010, 05:00 pm
Neither zone.lsp or tlen.lsp will run.
Any ideas?

Lee Mac
31st Mar 2010, 05:43 pm

Matt Schwartz
31st Mar 2010, 07:36 pm
Thank you.
Lencal.lsp works fine.

Matt

WodMarsden
2nd Jun 2011, 04:37 pm
Thank you for this lisp,i am very new to lisps.

Is there anyway you can have the table update automaticaly.

Say i delete or add sum more lines to the layer,can i have it so the table updates on its own?

Lee Mac
2nd Jun 2011, 04:45 pm
The table could be set to automatically update using Fields, although this is an old program and needs a lot of updating.

WodMarsden
3rd Jun 2011, 08:58 am
There anywer i can learn how to update it or is there a newer program?

harrison-matt
5th Jun 2011, 02:48 am
Where in the world did u get that lisp analizer?

WodMarsden
6th Jun 2011, 01:12 pm
Can any1 help me or teach me how to update this application.My plan is to have the table in a template border and weneva a certain layer is added the lengths are automatically added up and updated in the table weneva they are changed.

irneb
6th Jun 2011, 03:52 pm
I think your best bet would be to look into using Data Extraction. As example look at attached.

WodMarsden
7th Jun 2011, 09:02 am
Thank you very much for that irneb,is there anyway of making it so it updates itself wen a line is changed in length or a new line is added?

irneb
7th Jun 2011, 09:45 am
Not immediately, you have to save the DWG and it should pop-up with a DataLink requires update pop-up - which you can click for it to update. Or in the bottom right of the status bar should be an icon with what looks like 2 chain-links: right-click and select "Update All Data Links ...". Otherwise the command is DataLinkUpdate.

WodMarsden
7th Jun 2011, 10:35 am
How do i change what layer it is reading lengths from?

irneb
7th Jun 2011, 10:59 am
At present it reads all layers. To edit this you can add a filter: Select one of the cells of the table (single click so the bolded border of the cell is shown). Right-click and select Data Extraction --> Edit Data Extraction Settings. Click Next until you arrive at the Data Extraction - Refine Data (Page 4 of 7) dialog. Right click on the Layer column and select "Filter options" you can either pick each layer by urning on/off the checkbox next to its name, or adding a Begins with / Contains filter. OK & Next out until you reach the Finally button - after which the table should be updated.

You can do most things in that Refine Data page, e.g. change the number format of the Length column, or rename a column, sort the table on one or more columns, add calculated columns, etc.

BTW, for some reason I can't seem to combine different types of objects on the same layer into one line. I've hidden the Name (which I've renamed to Type) column, but it still shows 2/more lines per layer. Does anyone else know if there's a way to get round this? I've already selected Combine by Sum on the Length column, no other option available to the rest.

WodMarsden
7th Jun 2011, 11:18 am
It wont let me edit the Date extraction

irneb
7th Jun 2011, 11:34 am
It wont let me edit the Date extractionHave you extracted both the DWG and the DXE file in the ZIP I attached? You need to have them both in the same folder.

If it still doesn't work: As an alternative the attached is an eTransmit (which should have pathed the link relative to the DWG).

WodMarsden
9th Jun 2011, 11:25 am
Its great thanks,just need to try and figure out how to combine all the types.e.g arcs,line & pline.

irneb
9th Jun 2011, 02:40 pm
Its great thanks,just need to try and figure out how to combine all the types.e.g arcs,line & pline.Yes, I've got that same problem. It doesn't seem to allow such combinations! :(

WodMarsden
9th Jun 2011, 04:16 pm
Rename the display names in section 2 of 7,and then in the refine data section.right click on the header and change the combine record mode to sum values.

irneb
9th Jun 2011, 04:41 pm
Rename the display names in section 2 of 7,and then in the refine data section.right click on the header and change the combine record mode to sum values.Awesome! Thanks for that!

Attached is the modified files.