Nearest point within a radius

[WHM]

Good day all,

I've written a small program to remove blocks that are placed on top of each other based on your selection. The thing is it specifically checks the insert point and I'd like to add a tolerance to it.

Similar to the overkill commands tolerance.

Any suggestions?

(defun test_DupeDel (BLKA BLKB / ctr wpt sel Blknameb BLKb len Blkname lenb bnameA ctrb BLK ssB upt inspt ssC)

(setq ssC (ssget "X" (list (cons 0 "INSERT") (cons 2 (car BLKA)))))
(setq ctr 0);Sets list counter
(setq len (sslength ssC));Sets list length
	(while (/= ctr len)
		(setq Blkname (ssname ssC ctr));Selects entity name
		(setq BLK (entget Blkname))
		(setq inspt (cdr (assoc 10 BLK)));
		(setq wpt (trans inspt 1 0));point in WCS
		(setq upt (trans wpt 0 1));point in actual UCS				
		(if (setq ssB (ssget "C" upt upt (list '(0 . "INSERT") (cons 2 (car BLKB))(cons -4 "*,*,=")(cons 10 (list 0.0 0.0 (caddr upt))))));Second seslectionset based on the first ones insert point
			(progn
				(setq ctrb 0)
				(setq lenb (sslength ssB))
					(while (/= ctrb lenb)
						(setq Blknameb (ssname ssB ctrb))
						(entdel Blknameb)
					(setq ctrb (1+ ctrb))
					);while
			);progn
		);if
	(setq ssB nil)
	(setq ctr (1+ ctr))
	);while
(princ)
)

 

[Jonathan Handojo]

I actually posted this Block Overkill program not too long ago that you can download. It detects duplicate blocks and allows the user to either delete them, or move them to another layer. A circle will also be drawn in those duplicates. The overkill tolerance will be prompted too.

Edited November 5, 2020 by Jonathan Handojo

[WHM]

That is really useful program! The only problem is it only works for the same blocks. I'm trying to build a program that will do what your program is doing but with two selected blocks

 

Here is the full code:

It is still a work in progress, but try it out and have a look -

 

To start it you will need to type the command - Hello

 

A known issue is you need to have all objects in view for it to work

 

The HelloWorld.odcl has to be put into a AutoCAD support/search path. I haven't tested in a different on a different environment so I'm not sure it will work for you. If it doesn't just setq Variables for BLKA and BLKB and use this to invoke the function :

(test_DupeDel BLKA BLKB)

 

 

HelloWorld.lsp HelloWorld.odcl

[Jonathan Handojo]

Like this?

(defun test_DupeDel (blka blkb / tol)
    (setq tol (cond ((getreal "\nSpecify overkill tolerance <0.00001>: ")) (1e-5)))
    (if (equal (cdr (assoc 10 (entget (car blka)))) (cdr (assoc 10 (entget (car blkb)))) tol)
	(entdel (car blkb))
	)
    )

If you want to use my LISP code, comment out lines 98 & 99.

Edited November 5, 2020 by Jonathan Handojo

[WHM]

I tried using it, everything works but it doesn't take the tolerance into account for some reason

[Jonathan Handojo]

That's odd. Can you post a sample dwg so that I can test it out.

[WHM]

Here you go, have a look at this

Example 1.dwg

[Jonathan Handojo]

Specify a larger tolerance. The value I put 0.00001 is too small, the distance between those two blocks in your drawing is 0.06. Tolerance means the distance between the two blocks. If a smaller one doesn't work, try larger. Otherwise it's working fine for me

[WHM]

In that case I'm definitely wrongly implementing your code into my lsp!