Check number range for Overlap
Are there duplicates?
Different identifier , same values
Identifier: A1 Range: 12-24
Identifier: F1 Range: 12-24
or
Same identifier , different values
Identifier: A1 Range: 12-24
Identifier: A1 Range: 24-48
@cherrygate wrote:
...A1+D1, A1+E1+B1, B1+E1+A1+D1, D1+A1+E1+B1, E1+A1+D1, E1+B1
..
Some of the groupings seem to be better but than others are bit odd.
...
Joining the fun
(defun c:clash ( / _range low high ovl attbv blocks i lst )
;; pBe June 2021 ;;;
(defun _range (n m l / ol )
(while
(and n m (< (low n) (low m) (high n)))
(setq ol (cons (strcat (car n)"+"(car m)) ol))
(setq n (list (car ol) (strcat (itoa (low n))"-" (itoa (high m))))
l (cdr l) m (car l) )
)
(reverse ol)
)
(setq low (lambda (s)(atoi (cadr s))))
(setq high (lambda (s)
(atoi
(substr (cadr s) (+ 2 (vl-string-position 45 (cadr s))))
)
)
)
(if (setq blocks (ssget '((0 . "INSERT")(66 . 1))))
(progn
(repeat (setq i (sslength blocks))
(setq attbv (mapcar '(lambda (At)
(list (Vla-get-tagstring at)(Vla-get-textstring at)))
(Vlax-invoke (vlax-ename->vla-object
(ssname blocks (setq i (1- i)))) 'GetAttributes)))
(and
(setq lst (Cons
(mapcar '(lambda (tg)(cadr (assoc tg attbv)))
'("TERM_TAG" "FIBERS_USED")) lst))
)
)
(setq lst (Vl-sort lst '(lambda (a b)(< (cadr a)(cadr b)))))
(While (setq a (car lst))
(setq b (Cadr lst))
(if (setq f (_range a b (cdr lst))) (setq ovl (cons f ovl)))
(setq lst (cdr lst))
)
)
(princ "\nNo valid blocks found")
)
(if ovl
(print (substr (apply 'strcat (mapcar '(lambda (v)(strcat " | " v ))
(apply 'append (reverse ovl)))) 4))
(Alert "All OK")
)
(princ)
)
command: clash
"D1+A1 | D1+A1+E1 | D1+A1+E1+B1 | A1+E1 | A1+E1+B1 | E1+B1"
I'm getting almost similar values as @marko_ribar
Can you confirm if this is correct and not odd as you described it on your post?
@cherrygate wrote:
.."E1+B1" isn't necessary because it is already included in the A1+E1+B1 line...
If that rule applies then on the first drawing example should be
"D1+A1+E1+B1" <-- all the overlaps
This is what I got from your new example based on a modified code.
"A1+H1+D1+B1 | F1+C1 | E1+G1"
Here's a breakdown
"A1+H1+D1+B1"
(("A1" "1-13") ("H1" "3-6") ("D1" "11-16") ("B1" "12-24")
"F1+C1"
("F1" "25-48") ("C1" "25-48")
"E1+G1"
("E1" "49-62") ("G1" "61-72"))
Can you confirm it that is the right result?
@cherrygate wrote:With that being said, if this is the best result that can be achieved with AutoLISP then I would be ok with that result.
😄 It's not that @cherrygate , I'm sure it can be accomodated, but if the goal is to identify the values with overlaps, then the result would be sufficient enough for the task
(defun c:clash ( / _range low high ovl attbv blocks i lst a b f)
;; pBe June 2021 ;;;
(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 blocks (ssget '((0 . "INSERT")(66 . 1))))
(progn
(repeat (setq i (sslength blocks))
(setq attbv (mapcar '(lambda (At)
(list (Vla-get-tagstring at)(Vla-get-textstring at)))
(Vlax-invoke (vlax-ename->vla-object
(ssname blocks (setq i (1- i)))) 'GetAttributes)))
(if (Setq f (mapcar '(lambda (tg)(cadr (assoc tg attbv)))
'("TERM_TAG" "FIBERS_USED")))
(setq lst (Cons f lst))
)
)
(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 ovl
(print (substr (apply 'strcat (mapcar '(lambda (v)(strcat " | " v )) (reverse ovl))) 4))
(Alert "All OK")
)
(princ)
)HTH
Command: clash
Select objects:
"A1+H1+D1+B1 | F1+C1 | E1+G1"
Also, check out @ronjonp entry, the code yields similar results.
Another one.
(defun c:checkrange
( /
i ss att term_tags fibers_used list_to_string string_to_list overlap sit a b c d left cur tmp ret
)
(defun unique ( l )(if l (cons (car l) (unique (vl-remove (car l) l)))))
(defun string_to_list ( str del / pos )
(if (setq pos (vl-string-search del str))
(cons (substr str 1 pos) (string_to_list (substr str (+ pos 1 (strlen del))) del))
(list str)
)
)
(defun list_to_string (lst del)
(if (cdr lst)
(strcat (car lst) del (list_to_string (cdr lst) del))
(car lst)
)
)
(defun overlap (a b c d)
(or
(>= b c)
(>= b d)
)
)
(princ "\nSelect blocks to check >")
(setq ss (ssget '((0 . "INSERT"))) i -1)
(while (< (setq i (1+ i)) (sslength ss))
(setq att
(cons
(mapcar '(lambda (att) (cons(vla-get-tagstring att)(vla-get-textstring att))) (vlax-invoke(vlax-ename->vla-object(ssname ss i)) 'getattributes))
att)
)
)
(setq sit nil)
(foreach a att
(setq term_tags (cons (cdr (assoc "TERM_TAG" a)) term_tags))
(setq fibers_used (cons (mapcar 'atoi (string_to_list (cdr (assoc "FIBERS_USED" a)) "-")) fibers_used))
)
(setq sit (vl-sort (mapcar 'cons term_tags fibers_used) '(lambda (x y) (< (cadr x)(cadr y)))))
(setq i -1 ret (list))
(while (< (setq i (1+ i)) (1-(length sit)))
(setq left (nth i sit) j i tmp (list))
(setq a (cadr left) b (caddr left))
(while (< (setq j (1+ j)) (length sit))
(setq cur (nth j sit))
(setq c (cadr cur) d (caddr cur))
(if (overlap a b c d)(setq tmp (append tmp (list (car left) (car cur)))))
)
(if tmp (setq ret (append ret (list (unique tmp)))))
)
(if ret
(foreach e ret(princ (strcat "\n" (list_to_string e "+"))))
(princ "\nAll OK!")
)
(princ)
)Miljenko Hatlak
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
