Lisp to calculate total length By Layer fix
@kylei7449 wrote:
Thanks for the quick turn around, it does the first part but it returns 0". It loads and runs without any errors but it's not returning the total length.
That would be because the AREA command is commented out:
(setq en (ssname ss i)) ;(command "_.AREA" "_E" en)
It needs to run that command on an object in order to set the area and perimeter into the AREA and PERIMETER System Variables, so it will have numbers to add up. Try removing the semicolon.
[And by the way, though E (presumably for Entity) is still accepted as an option in the AREA command, at least as far as Acad2016 that I have here, the option as listed in the prompt has been O for Object for a long time now. It might be worth changing that, in case they drop E as an accepted option in the future.]
But there's no need to go through the AREA command if you're restricting it to Polylines and want only their lengths. They have a Length property that's directly available, avoiding the AREA command and the use of the PERIMETER System Variable.
Also, it looks like the reporting of how many open Polylines there were was part of what happened when you chose the Area option, but if you're looking only for Length, do you need to know that?
I've assumed that by "returns the total length in feet & inches" you mean rounded to the nearest whole inch. If not, adjust the 0 in the (rtos) function below for the precision you need.
Another little thing.... Your code pulls the Layer name out of its association with an 8 in the entity data list, and then later puts it back together with another 8 to use in the (ssget) filter list. You can just take the whole 8-code entry directly. [I would have omitted the 'lay' variable entirely, and just used (assoc 8 edata) right in the (ssget) filter list, if not for the inclusion of the Layer name in the report of the total length at the end.]
And I've built the selection differently, to avoid the "Select objects: " [always in the plural] prompt that (ssget) always uses, which is annoying when you only want a single object selected, and is always on a new line so the prompt you spelled out to precede it has moved up, and to avoid potential problems if a User selects more than one thing [though that can be prevented, with more code].
Here's my take on it, lightly tested:
;|
Length of Polylines by Layer
This command will give a total length for all Polylines on the Layer
of a selected one.
|;
(defun c:zone (/ esel edata lay ss total)
(while
(not
(and
(setq esel (entsel "\nPick any Polyline on the required layer"))
(setq edata (entget (car esel)))
(wcmatch (cdr (assoc 0 edata)) "*POLYLINE")
); and
); not
(prompt "\nNothing selected, or not a Polyline.")
); while
(setq
lay (assoc 8 edata)
ss (ssget "_X" (list (cons 0 "*POLYLINE") lay))
total 0
); setq
(repeat (setq n (sslength ss))
(setq total (+ total (vla-get-Length (vlax-ename->vla-object (ssname ss (setq n (1- n)))))))
); repeat
(prompt (strcat "\nTotal Length for Layer " (cdr lay) " = " (rtos total 4 0) "."))
(princ)
); defun
(vl-load-com)
@kylei7449 wrote:
.....next will be altering it to work via the selected polyline's linetype instead of by layer.
In that case, be careful about the difference between a linetype of BYLAYER, with the linetype of the Layer determining that of the Polyline, and an override linetype assignment, making the linetype of the Polyline independent of that of its Layer. The former has no linetype entry in entity data, so the selection becomes more complicated [but not impossible] -- not a simple (ssget) function with a filter list, unless every one on that Layer would be BYLAYER and no others would have that linetype as an override. But in that case you'd select them by Layer rather than linetype, anyway. If you might have some of each variety resulting in the same linetype, and you want to find all of them, it's more complicated still [but also doable].
@kylei7449 wrote:
....
(defun C:TLEN2 (/ ss tl n ent itm obj l)
(setq ss (ssget "x"
foreach lt '("get_linetype1" "get_linetype2" "get_linetype3" "get_linetype4" "get_linetype5" "get_linetype6"))
tl 0....(alert (strcat "Total length of selected objects is " (rtos tl))
) ;close foreach loop....
You can't embed a (foreach) function inside an (ssget) function like that [even if you do include the opening left parenthesis before the word foreach]. That would have to be structured differently, something like:
....
(defun C:TLEN2 (/ ss tl n ent itm obj l)
(foreach lt '("get_linetype1" "get_linetype2" "get_linetype3" "get_linetype4" "get_linetype5" "get_linetype6")
(setq
ss (ssget "x" (list (cons 6 lt)))
tl 0
....
(prompt (strcat "Total length of selected objects of " lt " linetype is " (rtos tl)))
) ;close foreach loop
....
See whether you can get that to work [I didn't dig deeply into the rest of it]. I changed the (alert) to (prompt) so there would be a remaining "record" in the command-line history of the results for every linetype, and it includes the linetype names in the prompts.
Consider also an (if) function around the (ssget), so that it doesn't try to find a total length if there are no objects of a given linetype, which will cause an error otherwise.
Another question: Your alert says "of selected objects", but your (ssget) has the "X" in it for searching the entire drawing without User selection. What's the intent?
Here is one more example. Adjust the linetype names and output format as needed.
;;Ranjit Singh
;;7/25/17
(defun c:somefunc (/ lst lst2)
(setq lst (vl-sort (mapcar '(lambda (x) (cons (getpropertyvalue x "Length") (cdr (assoc 6 (entget x)))))
(mapcar 'cadr (ssnamex (ssget "_x" '((0 . "lwpolyline") (6 . "NP8,G3,SD12"))))))
'(lambda (x y) (< (cdr x) (cdr y)))))
(mapcar '(lambda (x)
(if (null (member x lst2))
(setq lst2 (cons x lst2))))
(mapcar '(lambda (x)
(cons (cdr x)
(apply '+
(vl-remove nil
(mapcar '(lambda (y)
(if (= (cdr y) (cdr x))
(car x)))
lst)))))
lst))
(mapcar '(lambda (x) (princ (strcat (car x) " - " (rtos (cdr x) 2 2) "\n"))) lst2)
(princ (strcat "Total length of selected objects is " (rtos (apply '+ (mapcar 'cdr lst2)) 2 2)))
(princ))
@kylei7449 wrote:
....
(If (setq ss (ssget "x" (list (cons 6 lt)))
tl 0
n (1- (sslength ss)))
....
.... it needs to return the linetype name so it can be identified with the length (otherwise you have no idea what the lengths are associated with). I also need to tweak it to get rid of the area call, I just need the length. ....
You adopted my change of function from (alert) to (prompt), but you didn't adopt my adjustment of the prompt itself to include the linetype name with its corresponding total length.
The AREA command is a way of getting at the length of certain objects, not to get the area but in the process to set the PERIMETER System Variable value, which it then reads. It's a way of getting at the length of more complicated objects where you can't use the kinds of calculations it does with Lines or Arcs. BUT there's one universal way of getting the length from any of those things, eliminating a heck of a lot of code from the routine, like this:
(vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent))
No need for all that handling of different object types in different ways, no AREA command needed for some of them, no calculations from extracted (assoc) values.
There's also a problem with the code portion quoted above. You should have whether there are any of a given linetype be the one test in the (if) function. As you have it:
(If
(setq
ss (ssget "x" (list (cons 6 lt)))
tl 0
n (1- (sslength ss))
); setq
that (setq function will have a problem if there are none when it get to setting 'n' -- ss will be nil [not a selection set with 0 items in it, but just nothingness], and you'll get an error message from trying to get the length of nil. That's probably where your bad-argument error is coming from, when it looks that way at one of the other linetypes in the list. Do this instead:
(if
(setq ss (ssget "x" (list (cons 6 lt)))); close the (setq) for a test of the one question first, and if it finds any, then go on to:
(progn ; 'then' expression
(setq
tl 0
n (1- (sslength ss))
....
You can simplify:
(foreach
....
(if
(setq ss (ssget "x" (list (cons 6 lt))))
(progn ; 'then' expression
(repeat (setq n (sslength ss)); instead of (while)
(setq
ent (entget (setq itm (ssname ss (setq n (1- n))))); step 'n' down here instead of later
;;; [no need for 'obj' -- just set 'l' to that (vlax-curve...) function above]
....
); repeat
(prompt ....
); progn
); if
); foreach
@kylei7449 wrote:
.... if I have multiples of the same linetype it would give me the total lengths of that linetype instead of listing them separately.
Example, get_linetype1 = 5'-0", and if I have another segment of get_linetype1 at = 7'-0", it returns them as separate values instead of the aggregate of 12'-0". So what I need it to do is give me the aggregate total for each linetype. I will work on it...thanks, this is the what I was looking for.
It looks like the code in Post 13 is for only Polylines, which is clearly not in line with your original intent. And if expanded to handle more entity types, unless also otherwise significantly enhanced it would be limited to those that have a Length property, which is also not true of all the types in your original.
I'm tellin' ya, it can be a lot simpler and more universal:
(defun C:TLxLT ; = Total Length [by] LineType
(/ ss tl n ent)
(foreach lt '("get_linetype1" "get_linetype2" "get_linetype3" "get_linetype4" "get_linetype5" "get_linetype6")
(if (setq ss (ssget "_X" (list (cons 6 lt) '(0 . "*LINE,CIRCLE,ARC,ELLIPSE"))))
(progn ; then
(setq tl 0)
(repeat (setq n (sslength ss))
(setq
ent (ssname ss (setq n (1- n)))
tl (+ tl (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent))); FOR ALL TYPES
); setq
); repeat
(prompt (strcat "\nTotal length of selected objects of " lt " linetype is " (rtos tl)))
); progn
); if
); foreach
(princ)
); defun
(prompt "\nType TLxLT for Total Lengths by LineType.")
(vl-load-com)
Put your real linetypes into the list near the top, of course.
The *LINE part of the filter list covers Lines, Polylines of all types, and Splines, but If you ever use XLINEs or MLINEs with any of the linetypes as overrides, it will find those but won't be able to handle them [XLINEs because they have no end parameter (and of course infinite length, so you don't want them anyway), and MLINEs because they are not "vlax-curve"-class objects], so a check should be included to omit those from the calculations. Or if you do want MLINEs, additional code would have to be created to figure out their length.
@kylei7449 wrote:
Yes, this is closest to the output I'm looking for. My next task is to get it to give me the aggregate total including multiples. So, if I have multiples of the same linetype it would give me the total lengths of that linetype instead of listing them separately.
Example, get_linetype1 = 5'-0", and if I have another segment of get_linetype1 at = 7'-0", it returns them as separate values instead of the aggregate of 12'-0". So what I need it to do is give me the aggregate total for each linetype. I will work on it...thanks, this is the what I was looking for.
OK. Try below for example
;;Ranjit Singh
;;7/25/17
(defun c:somefunc (/ lst lst2)
(setq lst (mapcar '(lambda (x) (cons (getpropertyvalue x "Length") (cdr (assoc 6 (entget x)))))
(vl-remove-if 'listp
(mapcar 'cadr (ssnamex (ssget "_x" '((0 . "lwpolyline") (6 . "PHANTOMx2,TRACKS,ZIGZAG,HIDDEN2"))))))))
(vl-remove nil
(mapcar '(lambda (x)
(setq lst2 (cons (if (null (member x lst2))
x)
lst2)))
(mapcar 'cdr lst)))
(mapcar '(lambda (x)
(princ (strcat "\n=======\n" (car x)))
(mapcar 'print (cdr x))
(princ (strcat "\nTotal: " (rtos (apply '+ (cdr x)) 2 2) "\n=======\n")))
(mapcar '(lambda (x) (cons (cdar x) (mapcar 'car x)))
(mapcar '(lambda (y) (vl-remove-if-not '(lambda (x) (= y (cdr x))) lst)) (vl-remove nil lst2))))
(princ))
