Check number range for Overlap
@cherrygate wrote:
So I have come across one issue while using it in the real world - Sometimes there isn't a number RANGE and just a single number in that attribute, and it doesn't work.
How would you specifically want the program to respond when there is only a single number?
@cherrygate wrote:Just count it as a single number "range." So for example - If A1 is 1-6 and B1 is 3 it would trigger the overlap call out..
Before we do any modification, what of that "FIBERS_USED" is not even a number? what if its blank? or a combination of numbers and letters?
It could happen
@cherrygate wrote:
..Maybe if there is a way to handle those exceptions so that any data in that attribute that doesn't fit into the parameters it is looking for it calls that out in a separate list maybe? So it could output overlap list and then error list? Just an idea.
(defun c:clash ( / _SpacedOut _range low high ovl attbv blocks i lst a b f invalid WTPD)
;; pBe June 2021 ;;;
(defun _SpacedOut (str)
(vl-list->string (vl-remove 32 (vl-string->list str))))
(defun _range (n m l / ol )
(while
(and n m (or (< (low n) (low m) (high n))
(eq (cadr n)(cadr m))))
(setq ol (strcat (car n)"+"(car m)))
(setq n (list ol (strcat (itoa (low n))"-"
(itoa (max (high m)(high n)))))
l (cdr l) m (car l) )
)
(list ol l)
)
(setq low (lambda (s)(atoi (cadr s))))
(setq high (lambda (s)
(atoi
(substr (cadr s) (+ 2 (vl-string-position 45 (cadr s))))
)
)
)
(if (setq WTPD (ssadd) blocks (ssget '((0 . "INSERT")(66 . 1))))
(progn
(repeat (setq i (sslength blocks))
(setq attbv (mapcar '(lambda (At)
(list (Vla-get-tagstring at)
(_SpacedOut (Vla-get-textstring at))))
(Vlax-invoke (vlax-ename->vla-object
(ssname blocks (setq i (1- i)))) 'GetAttributes)))
(cond
((null (Setq f (mapcar '(lambda (tg)(cadr (assoc tg attbv)))
'("TERM_TAG" "FIBERS_USED"))))
)
( (wcmatch (setq r (Cadr f)) "*#-#*")(setq lst (Cons f lst)))
( (numberp (read r))
(setq lst (Cons (list (Car f) (strcat r "-" r)) lst))
)
( (setq invalid (cons (Car f) invalid))
(ssadd (ssname blocks i) WTPD)
)
)
)
(setq lst (Vl-sort lst '(lambda (a b) (< (atoi (cadr a))(atoi (cadr b))))))
(While (setq a (car lst))
(setq b (Cadr lst))
(if (Car (setq f (_range a b (cdr lst)))) (setq ovl (cons (Car f) ovl)))
(setq lst (cadr f))
)
)
(princ "\nNo valid blocks found")
)
(if (or ovl invalid)
(foreach itm (list
(list "\nOverlap: " ovl)
(list "\nWeird things people do: " invalid))
(if (cadr itm)
(princ (strcat (Car itm)
(substr (apply 'strcat (mapcar '(lambda (v)(strcat " | " v )) (reverse (cadr itm)))) 4)))
)
)
(Alert "All OK")
)
(sssetfirst nil WTPD)
(princ)
)
Command: Clash
Select objects: Specify opposite corner: 11 found
Select objects:
Overlap: A1+K1+H1+D1+B1 | F1+C1 | E1+G1
Weird things people do: Q2 | Q1
K1 : single number
C1 : Space after dash
E1 : Space before dash
Q1 : "I have a apple"
Q2 : <---- ( what are you looking for? its blank)
HTH
Side note: overlap | overlapped | overlapping?
I was on vacation so no time to play earlier in the week. Here's a quick mod to my existing code to possibly catch the other exceptions and highlight errors:
(defun c:foo (/ a b mn mx r r2 s s2)
;; RJP » 2021-06-18
(cond
((setq s (ssget '((0 . "INSERT") (66 . 1))))
(foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
(if
(and (= 'str (type (setq a (vl-catch-all-apply 'getpropertyvalue (list e "TERM_TAG")))))
(= 'str (type (setq b (vl-catch-all-apply 'getpropertyvalue (list e "FIBERS_USED")))))
)
(setq r (cons (list a (read (vl-string-translate "-" " " (strcat "(" b ")"))) e) r))
)
)
(setq s2 (ssadd))
;; Check if attribute is empty or does not contain all numbers
;; Read already stripped out extraneous spaces (read " ( 1 - 2 ) ")
(setq r (vl-remove-if
'(lambda (x)
(and (or (null (cadr x)) (null (vl-every 'numberp (cadr x))))
(ssadd (last x) s2)
(princ (strcat "\nBAD JUJU WITH: " (car x)))
)
)
r
)
)
(setq r (vl-sort r '(lambda (r j) (< (caadr r) (caadr j)))))
(while (setq a (car r))
(setq mn (caadr a))
(setq mx (cadadr a))
(setq r2 (vl-remove-if-not '(lambda (x) (or (<= mn (caadr x) mx) (<= mn (cadadr x) mx))) r))
(foreach e r2 (setq r (vl-remove e r)))
(if (= (length r2) 1)
(princ (strcat "\n" (car a) " - OK :)"))
(print (vl-sort (mapcar 'car r2)'<))
)
)
(sssetfirst nil s2)
)
)
(princ)
)
Returns:
BAD JUJU WITH: W1
BAD JUJU WITH: Y1
("A1" "D1" "Z1")
("B1" "E1")
C1 - OK 🙂
@pbejse wrote:
@cherrygate wrote:..Maybe if there is a way to handle those exceptions so that any data in that attribute that doesn't fit into the parameters it is looking for it calls that out in a separate list maybe? So it could output overlap list and then error list? Just an idea.
(defun c:clash ( / _SpacedOut _range low high ovl attbv blocks i lst a b f invalid WTPD)
;; pBe June 2021 ;;;
(defun _SpacedOut (str)
(vl-list->string (vl-remove 32 (vl-string->list str))))
(defun _range (n m l / ol )
(while
(and n m (or (< (low n) (low m) (high n))
(eq (cadr n)(cadr m))))
(setq ol (strcat (car n)"+"(car m)))
(setq n (list ol (strcat (itoa (low n))"-"
(itoa (max (high m)(high n)))))
l (cdr l) m (car l) )
)
(list ol l)
)
(setq low (lambda (s)(atoi (cadr s))))
(setq high (lambda (s)
(atoi
(substr (cadr s) (+ 2 (vl-string-position 45 (cadr s))))
)
)
)
(if (setq WTPD (ssadd) blocks (ssget '((0 . "INSERT")(66 . 1))))
(progn
(repeat (setq i (sslength blocks))
(setq attbv (mapcar '(lambda (At)
(list (Vla-get-tagstring at)
(_SpacedOut (Vla-get-textstring at))))
(Vlax-invoke (vlax-ename->vla-object
(ssname blocks (setq i (1- i)))) 'GetAttributes)))
(cond
((null (Setq f (mapcar '(lambda (tg)(cadr (assoc tg attbv)))
'("TERM_TAG" "FIBERS_USED"))))
)
( (wcmatch (setq r (Cadr f)) "*#-#*")(setq lst (Cons f lst)))
( (numberp (read r))
(setq lst (Cons (list (Car f) (strcat r "-" r)) lst))
)
( (setq invalid (cons (Car f) invalid))
(ssadd (ssname blocks i) WTPD)
)
)
)
(setq lst (Vl-sort lst '(lambda (a b) (< (atoi (cadr a))(atoi (cadr b))))))
(While (setq a (car lst))
(setq b (Cadr lst))
(if (Car (setq f (_range a b (cdr lst)))) (setq ovl (cons (Car f) ovl)))
(setq lst (cadr f))
)
)
(princ "\nNo valid blocks found")
)
(if (or ovl invalid)
(foreach itm (list
(list "\nOverlap: " ovl)
(list "\nWeird things people do: " invalid))
(if (cadr itm)
(princ (strcat (Car itm)
(substr (apply 'strcat (mapcar '(lambda (v)(strcat " | " v )) (reverse (cadr itm)))) 4)))
)
)
(Alert "All OK")
)
(sssetfirst nil WTPD)
(princ)
)
Command: Clash
Select objects: Specify opposite corner: 11 found
Select objects:
Overlap: A1+K1+H1+D1+B1 | F1+C1 | E1+G1
Weird things people do: Q2 | Q1
K1 : single number
C1 : Space after dash
E1 : Space before dash
Q1 : "I have a apple"
Q2 : <---- ( what are you looking for? its blank)
HTH
Side note: overlap | overlapped | overlapping?
Hi,
After using this for a few months I have found a situation it doesn't handle correctly (And the other variations of this script seem to miss too)
Example:
A1: 780
B1: 775-780
It seems that it doesn't check the last number in the group and looks like it is just checking 775-779 instead.
Any assistance modifying this script to handle that would be highly appreciated. Thank you!
@cherrygate wrote:After using this for a few months I have found a situation it doesn't handle correctly (And the other variations of this script seem to miss too)
Example: A1: 780 B1: 775-780
It seems that it doesn't check the last number in the group and looks like it is just checking 775-779 instead.
That's really embarassing 😁, I do apologies for that.
Not sure but a quick look at the code tells me this could be it:
(defun _range (n m l / ol ) (while (and n m (or (<= (low n) (low m) (high n)) (eq (cadr n)(cadr m)))) (setq ol (strcat (car n)"+"(car m))) (setq n (list ol (strcat (itoa (low n))"-" (itoa (max (high m)(high n))))) l (cdr l) m (car l) ) ) (list ol l) )
HTH
