Lisp for delete duplicate 3D Solids

[pizarro]

Delete a duplicate 3D solids, its posible whit a Lisp ?

Can you help me please.

 

[mhupp]

Union command if they are in the same place.

Edited September 13, 2022 by mhupp

[pizarro]

When there aren't many elements, it's fine, but when you have a large number of overlapping elements and you don't know what they are, the situation is complicated.

[Dadgad]

I'm not sure, but Overkill might do it?  

[mhupp]

6 hours ago, Dadgad said:

I'm not sure, but Overkill might do it?  

 

Unfortunately I think overkill only works on 2D objects.

I think you would have to

• make  a selection set of all solids
• compare them to each other by volume and geo center point
• if their is a match delete one

 

--edit

Could have false positive. so adding other tests would be better.

Edited September 15, 2022 by mhupp

[ronjonp]

1 hour ago, mhupp said:

 

Unfortunately I think overkill only works on 2D objects.

I think you would have to

• make  a selection set of all solids
• compare them to each other by volume and geo center point
• if their is a match delete one

 

--edit

Could have false positive. so adding other tests would be better.

Agree ... here is a quick one. Definitely test it as it can be fooled by solids with 'equal' volume at different locations.  Changed algorithm to be more reliable albeit slower.

(defun c:foo (/ a b o r s)
  (cond	((setq s (ssget "_X" '((0 . "3DSOLID"))))
	 (foreach e (mapcar 'cadr (ssnamex s))
	   (setq r
		  (cons	(list (vla-get-volume (setq o (vlax-ename->vla-object e))) (vlax-get o 'centroid) e)
			r
		  )
	   )
	 )
	 (setq r (vl-sort r '(lambda (r j) (< (car r) (car j)))))
	 (while	(setq a (car r))
	   (setq r (cdr r))
	   ;; Slower but more reliable
	   (setq b (vl-remove-if-not
		     '(lambda (x) (and (equal (car a) (car x) 1e-4) (equal (cadr a) (cadr x) 1e-4)))
		     r
		   )
	   )
	   (foreach x b (entdel (last x)) (setq r (vl-remove x r)))
;;;       (while (and (setq b (car r)) (equal (car a) (car b) 1e-4) (equal (cadr a) (cadr b) 1e-4))
;;;	 (entdel (last b))
;;;	 (setq r (cdr r))
;;;       )
	 )
	)
  )
  (princ)
)

 

Edited September 15, 2022 by ronjonp

[rax]

On 9/15/2022 at 7:47 PM, ronjonp said:

Agree ... here is a quick one. Definitely test it as it can be fooled by solids with 'equal' volume at different locations.  Changed algorithm to be more reliable albeit slower.

(defun c:foo (/ a b o r s)
  (cond	((setq s (ssget "_X" '((0 . "3DSOLID"))))
	 (foreach e (mapcar 'cadr (ssnamex s))
	   (setq r
		  (cons	(list (vla-get-volume (setq o (vlax-ename->vla-object e))) (vlax-get o 'centroid) e)
			r
		  )
	   )
	 )
	 (setq r (vl-sort r '(lambda (r j) (< (car r) (car j)))))
	 (while	(setq a (car r))
	   (setq r (cdr r))
	   ;; Slower but more reliable
	   (setq b (vl-remove-if-not
		     '(lambda (x) (and (equal (car a) (car x) 1e-4) (equal (cadr a) (cadr x) 1e-4)))
		     r
		   )
	   )
	   (foreach x b (entdel (last x)) (setq r (vl-remove x r)))
;;;       (while (and (setq b (car r)) (equal (car a) (car b) 1e-4) (equal (cadr a) (cadr b) 1e-4))
;;;	 (entdel (last b))
;;;	 (setq r (cdr r))
;;;       )
	 )
	)
  )
  (princ)
)

 

How can i move the duplicate object in to new layer instead of deleting??

[rax]

Can you bit adjust the lisp to delete duplicate object into a new layer instead of deleting??

[ronjonp]

10 minutes ago, rax said:

Can you bit adjust the lisp to delete duplicate object into a new layer instead of deleting??

;; Change this
(foreach x b (entdel (last x)) (setq r (vl-remove x r)))
;; to this
(foreach x b (append (entget (last x)) '((8 . "Duplicate"))) (setq r (vl-remove x r)))

 

[marko_ribar]

Ja, eto imam neke rutine vezane za sam overkill element...

Mozda Vam moze koristiti, mada nisam u potpunosti siguran...

OVERKILL.ZIP