extract the length of arc element with division into intervals, range
Another way, that doesn't require (vl) functions, and takes advantage of the fact that certain punctuation characters can be used in variable names:
(defun C:ACL ; = Arc Categories by Length
(/ ss n arc len)
(setq <10 0 <40 0 >=40 0)
(if (setq ss (ssget '((0 . "ARC"))))
(repeat (setq n (sslength ss))
(setq
arc (ssname ss (setq n (1- n)))
len (getpropertyvalue arc "Length")
);
(cond
((< len 10) (setq <10 (1+ <10)))
((< len 40) (setq <40 (1+ <40)))
((setq >=40 (1+ >=40)))
); cond
); repeat
); if
(list (cons (read "<10") <10) (cons (read "<40") <40) (cons (read ">=40") >=40))
); defunIt returns a list of pairs like this:
((<10 . 4) (<40 . 3) (>=40 . 2))
and leaves those quantities in the <10, <40 and >=40 variables for your further use if needed.
Sorry, I misread the intent as being the quantity of Arc objects within each length range, rather than the total of their lengths. I can adjust for that, later.
EDIT: A quicker adjustment than I anticipated....
(defun C:ALTC ; = Arc Length Totals by Category
(/ ss n arc len)
(setq <10 0 <40 0 >=40 0)
(if (setq ss (ssget '((0 . "ARC"))))
(repeat (setq n (sslength ss))
(setq
arc (ssname ss (setq n (1- n)))
len (getpropertyvalue arc "Length")
);
(cond
((< len 10) (setq <10 (+ <10 len)))
((< len 40) (setq <40 (+ <40 len)))
((setq >=40 (+ >=40 len)))
); cond
); repeat
); if
(list (cons (read "<10") <10) (cons (read "<40") <40) (cons (read ">=40") >=40))
); defun
I gave it a different command name, in case you want to be able to use both.
@JN05 wrote:
I was faced with the task of extracting a summary of the length of the arcs divided into intervals.
Looks fun, heres another way to skin a cat [ as a sub ]
by One Code Man ( programmer for fun )
(defun Infinityandbeyond ( data / s _str over s ei l)
;;; pBe Nov 2020 ;;;
(setq over 0 _str (lambda (v)(vl-princ-to-string v)))
(if (setq s (ssget '((0 . "ARC"))))
(repeat (setq i (sslength s))
(setq l (vlax-get (vlax-ename->vla-object
(ssname s (setq i (1- i)))) 'ArcLength))
(cond
((vl-some '(lambda (v / cl)
(if (<= l (car v))
(setq data (subst (cons (car v)(+ (cdr v) l)) v data))))
data
)
)
((setq Over (+ Over l)))
)
)
)
(mapcar '(lambda (a b)
(print (strcat "Length in the range of {>= "
(_str a)
"; <"
(_str (car b))
"}: "
(_str (Cdr b))
)
)
)
(cons 0 (mapcar 'car data))
(append data (list (cons "infinity" over)))
)
(princ)
)
Use it like this
_$ (Infinityandbeyond '((10 . 0)(40 . 0)))
"Length in the range of {>= 0; <10}: 7.75158"
"Length in the range of {>= 10; <40}: 80.1564"
"Length in the range of {>= 40; <infinity}: 97.5751" _$ (Infinityandbeyond '((10 . 0)(30 . 0)(40 . 0)(50 . 0)))
"Length in the range of {>= 0; <10}: 7.75158"
"Length in the range of {>= 10; <30}: 48.9954"
"Length in the range of {>= 30; <40}: 31.1609"
"Length in the range of {>= 40; <50}: 47.241"
"Length in the range of {>= 50; <infinity}: 50.3341"
Or you can even add a prompt for range values, but i will leave that for you to play with.
To make it simpler in preparation for the "prompt for range"
(defun Infinityandbeyond ( data / data _str over s ei l) ;;; pBe Nov 2020 ;;; (setq data (mapcar '(lambda (a) (cons a 0)) data))
....
Then call it like this
(Infinityandbeyond '(10 40)) (Infinityandbeyond '(10 20 30 40 50))
We can even show a break down and a total.
"Length in the range of {>= 10; <20}:
5.25 + 2.00 + 3.00 = 10.25"
The possiblities are endless
@JN05 wrote:
The bill of quantities checker will see what is being added.
Here's a quick mod
(defun Infinityandbeyond ( data etype / _plus s _str over s ei l)
;;; pBe Nov 2020 ;;;
(setq _plus (lambda (lst s)(substr
(apply 'strcat
(mapcar '(lambda (str)
(strcat s str) ) lst)
) (1+ (strlen s))
)
)
)
(setq data (mapcar '(lambda (a) (list a)) data ))
(setq _str (lambda (v)(vl-princ-to-string v)))
(if (setq s (ssget (list (cons 0 etype ))))
(progn
(repeat (setq i (sslength s))
(setq e (ssname s (setq i (1- i))))
(setq l (vlax-curve-getdistatparam e (vlax-curve-getendparam e)))
(cond
((vl-some '(lambda (v / cl)
(if (< l (car v))
(setq data (subst (append v (list l))
v data)))
)
data
)
)
((setq Over (cons l Over))
)
)
)
(mapcar '(lambda (a b)
(princ "\n------------------------------------------")
(princ (strcat "\nLength in the range of {>= "
(_str a) "; <" (_str (car b)) "}:" )
)
(princ
(if (setq val (cdr b))
(strcat "\n\t\t" (_plus (mapcar '_str val) " + ") " = " (_str (apply '+ val)))
"\t[ None Found ]"))
)
(cons 0 (mapcar 'car data))
(append data (list (cons "infinity" over)))
)
)
)
(princ)
)
Then you can make command names per range and type
(defun c:ArcSummary ()(Infinityandbeyond'(10 40) "ARC"))
Command: ARCSUMMARY
Select objects: Specify opposite corner: 9 found
------------------------------------------
Length in the range of {>= 0; <10}:
2.11634 + 3.1745 = 5.29084
------------------------------------------
Length in the range of {>= 10; <40}:
21.5768 + 19.267 + 32.3652 + 28.9005 = 102.11
------------------------------------------
Length in the range of {>= 40; <infinity}:
40.3987 + 86.2183 + 107.821 = 234.438(defun c:PlineSummary ()(Infinityandbeyond'(10 20 30 40) "LWPOLYLINE"))
Command: PLINESUMMARY
Select objects: Specify opposite corner: 10 found
------------------------------------------
Length in the range of {>= 0; <10}:
2.07658 + 8.84389 + 9.64276 + 3.11487 = 23.6781
------------------------------------------
Length in the range of {>= 10; <20}:
13.2658 + 14.4641 = 27.73
------------------------------------------
Length in the range of {>= 20; <30}: [ None Found ]
------------------------------------------
Length in the range of {>= 30; <40}:
38.4718 = 38.4718
------------------------------------------
Length in the range of {>= 40; <infinity}:
57.7077 + 66.3291 + 44.2194 = 168.256(defun c:WhateverSummary ()(Infinityandbeyond'(10 20 30 40) "LWPOLYLINE,LINE,ARC"))
Command: WHATEVERSUMMARY
Select objects: Specify opposite corner: 35 found
------------------------------------------
Length in the range of {>= 0; <10}:
9.84144 + 5.32298 + 2.07658 + 0.906825 + 2.11634 + 8.84389 + 9.64276 + 7.98446 + 3.11487 + 1.36024 + 3.1745 = 54.3849
------------------------------------------
Length in the range of {>= 10; <20}:
19.267 + 14.7622 + 13.2658 + 14.4641 = 61.7592
------------------------------------------
Length in the range of {>= 20; <30}:
21.5768 + 25.5917 + 28.1022 + 21.0488 + 28.9005 = 125.22
------------------------------------------
Length in the range of {>= 30; <40}:
30.3151 + 31.3353 + 38.4718 + 32.3652 + 38.3876 + 31.5732 = 202.448
------------------------------------------
Length in the range of {>= 40; <infinity}:
40.3987 + 86.2183 + 107.821 + 57.7077 + 66.3291 + 47.003 + 42.1533 + 45.4726 + 44.2194 = 537.323HTH
@JN05 wrote:
Can you help me and show me what the final LSP file should look like? Thank you very much for all your help. best regards
I'm attaching a lisp named Infinityandbeyond.lsp
Command: ARCSUMMARY
Command: PLINESUMMARY
Command: WHATEVERSUMMARY
Keep in mind that the range is hard-coded as '(10 40) for Arc objects, '(10 20 30 40) for LWPOLYLINES and also for the combination of these 3 obejct type "LWPOLYLINE,LINE,ARC")
You have to change the range on the lisp file
(defun c:ArcSummary ()(Infinityandbeyond'(10 40) "ARC")) (defun c:PlineSummary ()(Infinityandbeyond'(10 20 30 40) "LWPOLYLINE")) (defun c:WhateverSummary ()(Infinityandbeyond'(10 20 30 40) "LWPOLYLINE,LINE,ARC"))
And like i said before, we can add a prompt for range values in the future, but we need to know if the routine works for you as it stands now
