Lisp to detect pline and hatch overlaps

[karpki]

Hi,

What I'm trying to find:

The Lisp to detect overlapped plines (like an option) and hatches (most wanted)

the test picture looks squarely:

but indeed hatches and boundaries are overlapped:

The aim is

1/ to detect all the overlaps in a drawing

2/ highlight them by red circle or any other sign in the center of such overlapping area

f.e. like this:

It can be of course be visible by selecting all the drawing but 

- drawings are too difficult and big

- overlaps are mostly too small

So this kind of tool is extremely needed for finding mistakes

Thanks in advance for interest and answers!

[Moshe-A · Accepted solution]

@karpki  hi,

check this CMRK (cross mark) command.

you can select all polylines in one shoot. it compare two adjacent plines and if there is a difference between the concatenate area, it insert the "Attention label" on each crossing point. on your sample dwg there are more crossing point than you specified.

to give some room for a little error in area comparison, a CMRK-FUZZ variable is defined and set to a very small value

(setq CMRK-FUZZ 1e-2) ; fuzz for comparing equals areas

this evaluate to 0.01

if you find it too accurate increase this value.

note: block "Attention label" must be inside the dwg or on support file search path (otherwise you will get error)

enjoy

moshe

(defun c:cmrk (/ is_intersect double->lst ; local functions
                 CMRK-FUZZ ss data ename0 ename1 pline0 pline1 rgn1 rgnUnion doubles points)
  
 (defun is_intersect (o0 o1 / r)
  (if
   (not
     (vl-catch-all-error-p
       (setq r (vl-catch-all-apply 'vlax-invoke (list o0 'IntersectWith o1 acExtendNone)))
     )
   )
   r
  )
 ); is_intersect
  
 (defun double->lst (doubles / _index i lst)
  (setq _index (lambda (b inc) (+ (* b 3) inc)))
   
  (setq i -1)
  (repeat (/ (length doubles) 3)
   (setq i (1+ i)) 
   (setq lst (cons (list (nth (_index i 0) doubles) (nth (_index i 1) doubles) (nth (_index i 2) doubles)) lst))
  )
  
  lst
 ); double->lst

  
 ; here start c:cmrk
 (setvar "cmdecho" 0)
 (command "._undo" "_begin")

 (setq CMRK-FUZZ 1e-2) ; fuzz for comparing equals areas
  
 (if (setq ss (ssget '((0 . "lwpolyline") (70 . 1)))) ; select closed polylines
  (progn
   (setq data (mapcar '(lambda (ename) ename) (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
   
   (foreach ename0 (reverse (cdr (reverse data)))
    (setq pline0 (vlax-ename->vla-object ename0))
      
    (foreach ename1 (cdr (member ename0 data))
     (setq pline1 (vlax-ename->vla-object ename1))

     (if (and
           (setq doubles (is_intersect pline0 pline1))
           (setq points (double->lst doubles))
         )
      (progn
       (command ".region" "_si" (vlax-vla-object->ename (vla-copy pline0)))
       (setq rgn0 (entlast))
       
       (command ".region" "_si" (vlax-vla-object->ename (vla-copy pline1))) 
       (setq rgn1 (entlast)) 

       (command "._union" rgn0 rgn1 "")  
       (setq rgnUnion (vlax-ename->vla-object (entlast)))

       (if (not (equal (vla-get-area rgnUnion) (+ (vlax-curve-getarea pline0) (vlax-curve-getarea pline1)) CMRK-FUZZ))
        (foreach pt points
         (command "._insert" "Attention label" pt 1 1 0)
        )
       ); if
        
       (vla-delete rgnUnion)
       (vlax-release-object rgnUnion)
      ); progn
     ); if

     (vlax-release-object pline1)
    ); foreach

    (vlax-release-object pline0)
   ); foreach
   
  ); progn
 ); if

 (command "._undo" "_end")
 (setvar "cmdecho" 0)
  
 (princ)
); c:cmrk

[karpki]

Super!

It works !

Thank you very much!

[karpki]

Noticed that changing the FUZZ index doesn't affect the result

Used different figures from 1 to 10000 - same amount of alerts

Could you please explain how to adjust it?

[karpki]

One more issue which is not as critical as tuning the FUZZ

If there are objects inside boundaries (which are f.e. columns and they are excluded from the area hatch normally) - the given Lisp also shows contact points like mistakes

I guess this is because the lisp compares polylines intersection but not hatches

[Moshe-A]

@karpki ,

---

@karpki wrote:

Noticed that changing the FUZZ index doesn't affect the result

Used different figures from 1 to 10000 - same amount of alerts

Could you please explain how to adjust it?

---

(setq CMRK-FUZZ 1e-2) ; equal to 0.01

say the first polyline area is 1000.00 sq and the second polyline area is 1000.01 sq, the areas of the two will still be considered equal. as i said, if you experiencing to many intersections on a pair of polylines and the geometric digression is not significant, increasing CMRK-FUZZ will skip this pair 😀

attach is and update, added a pause letting you to change the fuzz each run. this way you control the fuzz more easily.

Moshe

[Moshe-A]

@karpki ,

---

@karpki wrote:

One more issue which is not as critical as tuning the FUZZ

If there are objects inside boundaries (which are f.e. columns and they are excluded from the area hatch normally) - the given Lisp also shows contact points like mistakes

I guess this is because the lisp compares polylines intersection but not hatches

---

that's right ,the lisp compare only polylines you select. to overcome this issue put the boundary polylines on separate layer.

by the way i'm curious? how come you end up to a situation where the hatch boundary is out of the hatch?

the hatch boundary should be associative and modifying geometry should align the hatch in place?!

Moshe

[karpki]

Doesn't matter previous or new LISP

behavior is same: changing the FUZZ in period from 0,0000001 to 100 000 doesn't affect to anything

[karpki]

Hatches I use are always associative

This is anyway great tool to check drawings/ thank you very much and sorry for my English, I'm not a super fluent speeking.... and can make mistakes in sentences.

What do you think if to ask about similar but I guess little bit other kind of mistake and tool for detection:

So the aim is to  detect all points of different polylines which weren't picked correctly but somewhere near in the area from 0.01 to 30 mm each from others:

and then to mark this area same way by red circle:

Should I open new request in the forum ? Or this Lisp could be reconstructed ?

Best regards

K

[Moshe-A]

@karpki ,

---

@karpki wrote:

Doesn't matter previous or new LISP

behavior is same: changing the FUZZ in period from 0,0000001 to 100 000 doesn't affect to anything

---

Sounds like you still did not understand what fuzz is, so here is more explanation...two adjacent plines are crossing creating a small shared area. if you enclose the two plines with boundary, you will get an area that is the sum of the two plines less the shared area - are you agree? and this is the fuzz.

in order to find two crossing plines, the program first check to see if they have crossing points. two plines that has a shared segment (two segments that lay on top of each other) still consider crossing at their shared points. so to determines if the plines are really crossing (and not just having shared segments) i use the sum area of that two minus the boundary area of the two. the difference is the fuzz.

say first pline has 10000 area

and the second has 11000 area

the enclose area of the two is 20000

the shared area is 1000 (this is the fuzz)

so if you want the lisp to skip labeling these two, set fuzz to 1000.

hope this is now more clear

Moshe

[Moshe-A]

---

@karpki wrote:

Hatches I use are always associative

This is anyway great tool to check drawings/ thank you very much and sorry for my English, I'm not a super fluent speeking.... and can make mistakes in sentences.

What do you think if to ask about similar but I guess little bit other kind of mistake and tool for detection:

So the aim is to  detect all points of different polylines which weren't picked correctly but somewhere near in the area from 0.01 to 30 mm each from others:

---

i am working on it, you will hear from me as soon as it finished

Moshe

[Moshe-A]

@karpki ,

solved - this was team effort thanks to Ronjonp  & CodeDing

the cmrk-fuzz now refers to a group of gathered crossing points.

enjoy

Moshe

(defun c:cmrk (/ askreal is_intersect double->lst _groupbyfuzz centrum ; local functions
                 CMRK-FUZZ ss data ename0 ename1 pline0 pline1 rgn1 rgnUnion doubles points cross grp)

 (defun askreal (def)
  (initget 4)
  (if (not (setq ask (getreal (strcat "\ncmrk-fuzz <" (rtos def 2) ">: "))))
   (setq ask def)
   (setq def ask)
  )
 ); askreal

  
 (defun is_intersect (o0 o1 / r)
  (if
   (not
     (vl-catch-all-error-p
       (setq r (vl-catch-all-apply 'vlax-invoke (list o0 'IntersectWith o1 acExtendNone)))
     )
   )
   r
  )
 ); is_intersect

  
 (defun double->lst (doubles / _index i lst)
  (setq _index (lambda (b inc) (+ (* b 3) inc)))
   
  (setq i -1)
  (repeat (/ (length doubles) 3)
   (setq i (1+ i)) 
   (setq lst (cons (list (nth (_index i 0) doubles) (nth (_index i 1) doubles) (nth (_index i 2) doubles)) lst))
  )
  
  lst
 ); double->lst

  
 ; by jonronp
 (defun _groupbyfuzz (l f / a b r)
  (while (car l)
   (setq a (car l))
   (setq b (vl-remove-if-not '(lambda (x) (equal a x f)) l))
   (foreach c (append (list a) b) (setq l (vl-remove c l)))
   (setq r (cons b r))
  )
  r
 ); _groupbyfuzz


 (defun centrum (g / l)
  (mapcar
   '(lambda (x y)
     (/ (+ x y) 2) 
    )  
    (car
      (setq l
            (mapcar
              '(lambda (f0)
                 (mapcar
                   '(lambda (f1)  
                     (apply f0 (mapcar '(lambda (p) (f1 p)) g))
                    )
                   (list car cadr)
                 )
               ); lambda
              (list 'min 'max)
            )
      ); setq
    ); car
    (cadr l)
  ); mapcar
 ); centrum

  
 ; here start c:cmrk
 (setvar "cmdecho" 0)
 (command "._undo" "_begin")

 (setq cross nil)
  
 (if (= (getvar "userr1") 0)
  (setq def-fuzz (setvar "userr1" 1e-2))
  (setq def-fuzz (getvar "userr1"))
 )
 
 (if (and
       (setvar "userr1" (setq cmrk-fuzz (askreal def-fuzz)))
       (setq ss (ssget '((0 . "lwpolyline") (70 . 1)))) ; select closed polylines
     )
  (progn
   (setq data (mapcar '(lambda (ename) ename) (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
   
   (foreach ename0 (reverse (cdr (reverse data)))
    (setq pline0 (vlax-ename->vla-object ename0))
      
    (foreach ename1 (cdr (member ename0 data))
     (setq pline1 (vlax-ename->vla-object ename1))

     (if (setq doubles (is_intersect pline0 pline1))
      (progn
       (command ".region" "_si" (vlax-vla-object->ename (vla-copy pline0)))
       (setq rgn0 (entlast))
       
       (command ".region" "_si" (vlax-vla-object->ename (vla-copy pline1))) 
       (setq rgn1 (entlast)) 

       (command "._union" rgn0 rgn1 "")  
       (setq rgnUnion (vlax-ename->vla-object (entlast)))

       (if (and
             (not (equal (vla-get-area rgnUnion) (+ (vlax-curve-getarea pline0) (vlax-curve-getarea pline1)) 0.0))
             (setq points (double->lst doubles))
           )
        (setq cross (append cross points))
       ); if
        
       (vla-delete rgnUnion)
       (vlax-release-object rgnUnion)
      ); progn
     ); if

     (vlax-release-object pline1)
    ); foreach

    (vlax-release-object pline0)
   ); foreach

   (foreach grp (_groupbyfuzz cross cmrk-fuzz)
    (entmake
      (list
       '(0 . "insert")
       '(2 . "attention label")
       (cons '10 (centrum grp))
       '(41 . 1.0)
       '(42 . 1.0)
       '(43 . 1.0)
       '(50 . 0.0)
      )
    ); entmake
   ); foreach
  ); progn
 ); if

 (command "._undo" "_end")
 (setvar "cmdecho" 0)
  
 (princ)
); c:cmrk

[Moshe-A]

@karpki,

ronjonp (the coder) of (_groupbyfuzz) send an update a more efficient (_groupbyfuzz2) >> HERE << 

he recommend to replace . also you might want to take a look at (groupbyfuzz) from CodeDing.

Moshe

[karpki]

Thank you Moshe! Trying to read and test all these materials.

BR

K

[karpki]

Could you please give your sample file and suggestion what a fuzz index I should choose to get attention label in the right place

[Moshe-A]

@karpki 

the cmrk-fuzz plays like a circle diameter, just measure the distance between a cluster of crossing points and round it up say by 10-20%?

Moshe

[karpki]

I choose 10

Code detects all intersections from 1 to much more than 10 mm, why ?

Sample test is from 1 to 50 - all detected:

And it ignores spaced out vertices - no any labels:

[Moshe-A]

post this dwg and i will check it tomorrow cause here is midnight and i am badly need some sleep  😀

good night

[Moshe-A]

@karpki ,

i think i now under stand you 😀

first picture:

As said the cmrk-fuzz plays like a diameter to detect a cluster of crossing points and for a cluster it label it once. a cluster can have 1 point or more (in the previous version it labels all crossing points and you said i do not want that?!). it seems to me that you are expecting the program to label only a cluster? you do not want to know if there is only 1 crossing problem? whereas 1 problem can be a big gap?

second picture:

CMRK labels only when it finds crossing points. in picture two it look like there are no crossing points - are there?

Moshe

[karpki]

If only crossing then OK

And yes one label around the cluster is absolutely enough

BR

Kirill