LISP to find mismatched points

[karpki]

Hi

I spend a lot of time zooming and checking crossing points. 

It happens very often that points are mismatched, I guess you all noticed it many times.

I could say all those drawings come from third party architects but indeed I do such mistakes also .. Especially when basement drawing is made with very poor quality and many doubled lines.

The result affects summaries a lot and such mistakes must be healed.

Is there any idea how to detect them by the LISP program and label such areas f.e. by red circle:

F.e. the gap between points should be from 0.01 to 20 mm to label it as a mistake

Thanks in advance for help!

BR

Karpki

[james_moore]

This sounds like a tall order, more information needs to be gathered to do this in some automated way IMHO.  I'm not sure how to automatically detect what endpoints are supposed to meet or intersect based off of just lines, & I envision that by the time you gather/input information about how long walls should be, room dimensions, wall thicknesses, you might as well be writing a LISP that draws it for you as opposed to detecting where you have made errors.  Where there's a will there's a way though!  Hope someone steeped in arch. drafting & design sees it more optimistically.

[karpki]

Well probably this is again something impossible...

From my point of view (noob in coding) the logic could be like this:

1/ Selection area by user

2/ Filtering polylines from all the trash selected, easy code I think

3/ Make a list of all points of all polylines, shouldn't be difficult

4/ Getting distances between nearlayered ones, how to filter those - I think this is the main problem

5/ If distance in a kind of "mistake" limits mark area by label

Amount of choosen polylines can be limited by 4 to simplfy the process

[james_moore]

rough beginnings...

(setq PT1 (getpoint) PT2 (getpoint))  ; ; make the user select some area, assume they will use a crossing window

(setq USEROBJECTS (ssget "_C" pt1 pt2 '((0 . "LWPOLYLINE")))) ;; select only polylines in that area

; now list all points of all polylines, for each PLINEOBJ in USEROBJECTS

(setq COUNT 0)

(repeat (sslength USEROBJECTS)

 (setq TEMPVALUE (ssname USEROBJECTS COUNT))

  ;; process to find endpoints here...

 (setq COUNT (1+ COUNT))

)

.... the easier part, just for starters

[john.uhden]

It's not that difficult, that is once you have defined the rules.

We can check all polylines to see if there are coincident vertices.  In fact we can check all polylines to see which are closest to others within a specified distance, and then put a big fat donut at such locations, if that would help.  However, I doubt that too many of us here will spend the time to "fix" all the abnormalities for you.

BTW, when you say "points" I presume you mean polyline vertices, right?

[Sea-Haven]

Pretty sure this has been asked before not that long ago maybe on another forum, the end result was like John's reply something may be possible, the issue was for the other request just fix a whole dwg automatically. The issue was with multiple points which one is the correct one as the base point. Look at original image.

A side partial solution was a post about using "Revit align" in Autocad that would move a pline vertice to a point but keep parallel alignment of the segment. Again look at image. Test code was provided. If useful can post.

[ВeekeeCZ · Accepted solution]

Try this code. I didn't try it on the large data set, so try yourself if the algorithm is feasible.

(vl-load-com)

(defun c:MarkMismatches ( / fuz sel vrs vrt nst)
  
  (setq fuz (getreal "\nFuzz: "))
  
  (if (and (setq sel (ssget '((0 . "LWPOLYLINE"))))
	   (setq vrs (mapcar 'cdr (apply 'append (mapcar '(lambda (e) (vl-remove-if '(lambda (c) (/= 10 (car c))) (entget e)))
							 (vl-remove-if 'listp (mapcar 'cadr (ssnamex sel)))))))
	   )
    (while (setq vrt (car vrs)
		 vrs (cdr vrs))
      (if (and (setq nst (vl-remove-if-not '(lambda (v) (< (distance vrt v) fuz)) vrs))  	; all vertices in nest (within fuzz)
	       (setq vrs (vl-remove-if '(lambda (v) (< (distance vrt v) fuz)) vrs))		; remove them from the main set to not be processed anymore
	       (setq nst (vl-remove-if '(lambda (v) (equal vrt v 1e-14)) nst))			; remove all precise vertices from the nest
	       )
	(entmake (list '(0 . "CIRCLE") '(8 . "_Nests") (cons 40 fuz)
		       (cons 10 (mapcar '/ (list (apply '+ (mapcar 'car nst)) (apply '+ (mapcar 'cadr nst))) (list (length nst) (length nst)))))))))
  (princ)
  )
 

[john.uhden]

Alan,
You are jogging my memory. Maybe we had a situation where if points were
near enough to one another we used the median value, no it was the mode.
I found it. It was for finding the best center of a bundle of circles that
were close but not exact...
"(defun c:CENTER ( / *error* vars vals fuzz ss i circles mode m n @Anonymous
@dxf10 @average)
;; V1.0 (09-18-18) For luiz.toniolo by John Uhden
;; Command function to shift locations of groups of circles to each
group's mode"

[karpki]

right, yes

[karpki]

In process of testing

Thanks!

Will be back

[Sea-Haven]

My understanding is for say rectangs in particular ortho based, this is desired result. Happy to be advised wrong answer.

It may be as posted already highlite the imperfection point, then pick a control point and move objects to suit.

[braudpat]

Hello @ВeekeeCZ 

1) Thanks , I like your routine "MarkMismatches" on LWPOLYLINE !

2) Please could you give me / us the variant for Blocks (classic & dynamic) ?

3) SORRY to be a little bit "OUT" from the original Topic !

The Health (Stay Safe, Stay Home, Stay Live), Bye, Patrice (The Retired Old French EE Froggy)

[ВeekeeCZ]

---

@braudpat wrote:

Hello @ВeekeeCZ 

...

2) Please could you give me / us the variant for Blocks (classic & dynamic) ?

...

---

Do you mean to compare block insertion points?

Or post some dwg with examples to take a look at what you have in mind.

[braudpat]

Hello

Yes Compare Block Insertion Points on XY (or XYZ if possible) ...

And if possible for Blocks & Points ...

Please 2 questions :
Q1) Fuzz / Analysis distance (Default = 1.0) ?
Q2) Circle Radius (Default = 3.14) ? So easy to find them after with QSELECT ...
Circles will be drawn on current layer with a XYZ at "each" Block found with other Blocks around ...

Do you need a DWG ? ... I have added a DWG ...

With a fuzz / analysis distance = 1.0 : many circles

With a fuzz / analysis distance = 0.5 : a few circles

The Health, Bye, Patrice

[ВeekeeCZ · Accepted solution]

---

@braudpat wrote:

Hello

Yes Compare Block Insertion Points on XY (or XYZ if possible) ...

And if possible for Blocks & Points ...

Please 2 questions :
Q1) Fuzz / Analysis distance (Default = 1.0) ?
Q2) Circle Radius (Default = 3.14) ? So easy to find them after with QSELECT ...
Circles will be drawn on current layer with a XYZ at "each" Block found with other Blocks around ...

Do you need a DWG ? ... I have added a DWG ...

With a fuzz / analysis distance = 1.0 : many circles

With a fuzz / analysis distance = 0.5 : a few circles

The Health, Bye, Patrice

---

Here it is. I kept the radius R=fuz. It put the circles to their own layer _Nests, so should not be difficult to find them. Or if you still want to have 3.14, change (cons 40 3.14)

(vl-load-com)

(defun c:MarkMismatches ( / fuz sel vrs vrt nst)
    
  (if (and (setq sel (ssget '((0 . "INSERT"))))
	   (setq fuz (cond ((getdist "\nFuzz distance <1.0>")) (1.)))
	   (setq vrs (mapcar 'cdr (apply 'append (mapcar '(lambda (e) (vl-remove-if '(lambda (c) (/= 10 (car c))) (entget e)))
							 (vl-remove-if 'listp (mapcar 'cadr (ssnamex sel)))))))
	   )
    (while (setq vrt (car vrs)
		 vrs (cdr vrs))
      (if (and (setq nst (vl-remove-if-not '(lambda (v) (< (distance vrt v) fuz)) vrs))  	; all vertices in nest (within fuzz)
	       (setq vrs (vl-remove-if '(lambda (v) (< (distance vrt v) fuz)) vrs))		; remove them from the main set to not be processed anymore
	       (setq nst (vl-remove-if '(lambda (v) (equal vrt v 1e-14)) nst))			; remove all precise vertices from the nest
	       )
	(entmake (list '(0 . "CIRCLE") '(8 . "_Nests") (cons 40 fuz) (cons 10 vrt))))))
  (princ)
  )

[braudpat]

Hello

THANKS your routine is "perfect and so short" !

The Health, Bye, Patrice

[ВeekeeCZ]

Glad to help, @braudpat 

[karpki]

Hi and Thank you very much!

It works

Two questions

1/ Could you please give a suggestion how to adjust sensitiveness

It marks very small distances what is not needed in real

Probably 0.5 mm is a minimum what should be marked

If not possible then OK, no problems

2/ How to make circles always D1200 and red

Best Regards

K

[ВeekeeCZ · Accepted solution]

Added some comments to the code to make understanding easier. Good luck

(vl-load-com)

(defun c:MarkMismatches ( / pre sel vrs vrt nst)
  
  (or *mm-fuz*
      (setq *mm-fuz* 1000)) 	; default fuz (= maximal faulty)
  (setq pre 1e-14)		; default pre (= mininal faulty)
  
  (if (and (setq sel (ssget '((0 . "LWPOLYLINE"))))
	   (setq *mm-fuz* (cond ((getdist (strcat "\nFuzz distance <" (vl-princ-to-string *mm-fuz*) ">: "))) (*mm-fuz*)))
	   (setq vrs (mapcar 'cdr (apply 'append (mapcar '(lambda (e) (vl-remove-if '(lambda (c) (/= 10 (car c))) (entget e)))
							 (vl-remove-if 'listp (mapcar 'cadr (ssnamex sel)))))))
	   )
    (while (setq vrt (car vrs)
		 vrs (cdr vrs))
      (if (and (setq nst (vl-remove-if-not '(lambda (v) (< (distance vrt v) *mm-fuz*)) vrs))  	; all vertices in nest (within fuzz)
	       (setq vrs (vl-remove-if '(lambda (v) (< (distance vrt v) *mm-fuz*)) vrs))	; remove them from the main set to not be processed anymore
	       (setq nst (vl-remove-if '(lambda (v) (equal vrt v pre)) nst))			; remove all precise vertices from the nest
	       )
	(entmake (list '(0 . "CIRCLE") '(8 . "_Nests") '(40 . 1200) '(62 . 1)			; layer - radius - color
		       (cons 10 (mapcar '/ (list (apply '+ (mapcar 'car nst)) (apply '+ (mapcar 'cadr nst))) (list (length nst) (length nst)))))))))
  (princ)
  )

[karpki]

Just brilliant!

Thank you very much!