common entities at one point

[GP.]

I first selected "all", then entered your code.. .

ssget still requires a selection, it is useless to select first.
if it doesn't work maybe your version of lisp is really too dated.. .

This is what is written as a ssget list.
another account is to imagine it before writing this selection. . .

I've been taking notes over the years.

the condition (-4 . ....) I remember wrong that it closed also with a -4?

the -4 closure serves with conditions like or, and, not...
(ssget "_x"((8 . "lines") (-4 . "<or") "or="" (-4="" (62="" .="" 1)="" 2)="">")


Note: the 59 seconds or 21 minutes used for testing the 16200 lines with the gio_s code equal half a second with autocad, gstarcad or progecad overkill. </or")>

 

[Gio_S]

Now I will try to implement your selection for faces, I don't think it is implemented, because it doesn't give me any mistake.
I'm sure I'm wrong, or I'd like to highlight list or syntax heirs.
I had posted the function on the lines because it is the most compact, but the one for the faces also overkill does not.
I think they should have made too many distinctions, depending on your needs.
with the faces the cases to be compared are many.
direction of rotation, three or four sides, four "false" sides, or repetition of a vertex in any position. perhaps they did not implement it because the case is varied. my currently working (slowly) only on three sides, because I enter and exit from the stl that consider only three...
I really need your function to turn, because then the comparisons, in the nested loop, are so many.
for example for me two 4 faces described so
a,b,b,d or a,b,d,d are equal... as it is to them equal b,d,a,a
I don't know if autocad, saving, cleaning up and describing the three-sided faces like a,b,c . which would like to compare it are with b,c,a, with c,a,b and its inverse senses.
a,b,b,c for example are typical cases of effect of a stretch that doubles the vertices creating two falsely different because they persist in the same point b.
not to mention the very long values to mobile comma, for which, after a bit of rotation, or subdivisions, all faces become different, but in practice should theoretically be equal, and I must obtain no more than eight decimals after the comma, to protect me from the results of floating point operations.. I mean, I don't know if I can explain. I have to pin the values as double, interrupt them as single, and only then compare them.
in fact in the function on the lines if you see there is the option on the equal that normalizes to a tot of decimals.
Sometimes, to make it short, I get to have to throw out a dxf at 4 decimals, the more I certainly don't need in the press, and then I reload it "clean".

 

[Gio_S]

There! !
Great! I started studying and this thing selects in a bounded box!
(ssget "c"(0 0 0) '(100 100 15)) ... objects under 15 of quota, and within x and y = 100However they say depending on the order of declared points will be win or crossing ..in short we are on the very good road to find only the entities that coincide between them (and then delete them)

edit, ho correct, win or cross goes for string "b", not "c". but I can't make it work.

 

[GP.]

I started studying and this thing selects in a bounded box!
(ssget "c"(0 0 0) '(100 100 15)) ... objects under 15 of quota, and within x and y = 100

I'm sorry to give you bad news, but the b (box) option is related to a rectangle of selection, not to bounding box
if the points are specified from right to left, the selection happens with crossing, otherwise with windows.

 

[Gio_S]

I thought it was working yesterday. Maybe I messed up with previous selections, now it gave me discontinuous results.
Anyway now I have tried again as it interests me to delete duplicates.
(ssget "c"(15 15 15) '(15 15 15) i.e. with two equal triangles with 15,15,15
I got them both and only them, and it also works after inverting the rotation of the second!
even with different elevation from zero!
instead the b gives me "bad string"
I looked at my help, man, they're all implemented but the b no!!! for that didn't go.
cmq I will tell you in case of surprises.

 

[Gio_S]

I can't reach the famous 58 seconds but now it's all another story! ! !
Very fast! and I'm also penalized because this version makes a redraw at every cancellation that the old routine did not. But now I look at it, I don't remember if it was here or in other drawing program that you can suspend the redraw. honor (usual) to gp
I don't know if I do it on autocad.
ps. first draft thrown down the race, could have gaps.

(defun deletelinecopyv ()
(prompt "\ndelete line copy new: ") (setq selez(ssget))) (setq dead 0 spy 0)
(if (/= nil selez)
(progn)
(setq max (sslength selez) Contasel 0)
(while (> max contasel)
(setq en (ssname selez contasel) alist (entget en)
(if (or (= "3dline" (cdr(assoc 0 alist)))) (= "line" (cdr(assoc 0 alist)))))
(progn)
(setq dead 0 numscope 0)
(setq pnta (cdr(assoc 10 alist)) pntb (cdr(assoc 11 alist))
(setq flatness 0)
(setq encross)
(ssdel encross)
(setq numscope (sslength encross)
;(princ (rtos numscope))
;(princ "here")

(while (and (> numscope spy) ( /= dead 1) )

(setq en2 (ssname encross pavement) alist2 (entget en2))
(setq pnta2 (cdr(assoc 10 alist2)) pntb2 (cdr(assoc 11 alist2)) )

(if (and (equal pnta2 0.00000001) (equal pntb pntb2 0.00000001)) (setq dead 1) )
(if (and (equal pntb2 0.00000001) (equal pntb pnta2 0.00000001)) (setq dead 1) )
(setq flatness (+ flatness 1) )
)
)
)
(if (= dead 1)(entdel en))
(setq dead 0 spy 0)
(princ)
(setq contasel (+ 1 accountant))
)
)
)
)

 

[Gio_S]

Here, get better.
- removed redundant assignments
- search window of the loop reduced to one point (which was then my initial purpose).
now it is necessary to prepare the version for cleaning 3dface, which is quite boring because the checks to be made between the faces that seem to be different are really many, but that there is not even on autocad.

(defun deletelinecopyv)
(prompt "\ndelete line copy new: ") (setq selez(ssget)))
(if (/= nil selez)
(progn)
(setq max (sslength selez) contasel 0)
(while (> max contasel)
(setq in (sssname selez contasel) alist (entget in)
(if ( gold (= "3dline" (cdr(assoc 0 alist)))
(progn)
(setq dead 0 numscope 0 spiazza 0)
(setq pnta (cdr(assoc 10 alist)) pntb (cdr(assoc 11 alist)) )
(setq encross (ssget "c" pnta pnta))
(ssdel in encross)
(setq numscope (sslength encross))

(while (> numscope spiazza) ( /= dead 1)

(setq en2 (sssname encross spiazza) alist2 (entget en2)
(setq pnta2 (cdr(assoc 10 alist2)) pntb2 (cdr(assoc 11 alist2))

(if (and (equal pnta2 0.00000001)(equal pntb pntb2 0.00000001)) (setq dead 1)
(if (and (equal pnta pntb2 0.00000001)(equal pntb pnta2 0.00000001)) (setq dead 1)
(setq spiazza (+ spiazza 1) )
)
)
)
(if (= dead 1)
(princ ".")
(setq contasel (+ 1 contasel))
)
)
)
)

 

[Cristallo]

I'm glad you opened a world.

 

[Gio_S]

I'm glad you opened a world.

even more than one, with this method of the window that becomes a multiple getpoint, I think I will have to see a lot, among my usefulness!

 

[Gio_S]

if it can serve to someone, since autocad at the moment seems not to do it, place here also the routine for the duplicate 3dfaces. just written, it is not excluded can contain gaps!
ps, I briefly commented though it is simple!

;############################################################

(defun deletefacecopy)
(prompt "\ndelete 3dface copy: ") (setq selez(ssget))))
(if (/= nil selez)
(progn)
(setq max (sslength selez) contasel 0)
(while (> max contasel)
(setq in (sssname selez contasel) alist (entget in)
(if (= "3dface" (cdr(assoc 0 alist)))
(progn)
(setq dead 0 numscope 0 spiazza 0 triangle 0 triangle2 0)
(setq pnta (cdr(assoc 10 alist) pntb (cdr(assoc 11 alist)) pntc (cdr(assoc 12 alist) pntd (cdr(assoc 13 alist)) )

spinge a d ogni eventuale ripetizione di vertice
(if (equal pntb pnta) (setq pntb pntc pntd)
(if (equal pntc pntb) (setq pntc pntd)
(if (equal pntd pnta) (setq pntd pntc)
;(princ pnta )
;(princ pntb )
;(princ pntc )
;(princ pntd )
(setq encross (ssget "c" pnta pnta))
(ssdel in encross)
(setq numscope (sslength encross))

(while (> numscope spiazza) ( /= dead 1)

(setq en2 (sssname encross spiazza) alist2 (entget en2)
(setq pnta2 (cdr(assoc 10 alist2)) pntb2 (cdr(assoc 11 alist2))
(setq pntc2 (cdr(assoc 12 alist2)) pntd2 (cdr(assoc 13 alist2)) )

spinge a d2 ogni eventuale ripetizione di vertice
(if (equal pntb2 pnta2) (setq pntb2 pntc2 pntc2 pntd2)
(if (equal pntc2 pntb2) (setq pntc2 pntd2)
(if (equal pntd2 pnta2) (setq pntd2 pntc2)

(if (equal pntc pntd) (setq triangle 1) )
(if (equal pntc2 pntd2) (setq triangle2 1) )

;(princ (rtos triangle) )

(if (and (= triangle 1)(= triangle2 1) ; 3 lati
(progn)
(if (and (equal pnta2 0.0001)(equal pntb pntb2 0.0001)(equal pntc pntc2 0.0001))(setq dead 1) )
(if (and (equal pnta pntb2 0.0001)(equal pntb pntc2 0.0001)(equal pntc pnta2 0.0001) )(setq dead 1)
(if (equal pnta pntc2 0.0001)(equal pntb pnta2 0.0001)(equal pntc pntb2 0.0001))(setq dead 1) )
(if (and (equal pnta2 0.0001)(equal pntb pntc2 0.0001)(equal pntc pntb2 0.0001))(setq dead 1) ; reverse rotation
(if (and (equal pnta pntb2 0.0001)(equal pntb pnta2 0.0001)(equal pntc2 0.0001))(setq dead 1) )
(if (and (equal pnta pntc2 0.0001)(equal pntb pntb2 0.0001)(equal pntc pnta2 0.0001))(setq dead 1) )
)
)
(if (and (= triangle 0)(= triangle2 0) ; 4 lati
(progn)
(if (and (equal pnta2 0.0001)(equal pntb pntb2 0.0001)(equal pntc pntc2 0.0001)(equal pntd pntd2 0.0001))(setq dead 1) )
(if (and (equal pnta pntb2 0.0001)(equal pntb pntc2 0.0001)(equal pntc pntd2 0.0001)(equal pntd pnta2 0.0001))(setq dead 1) )
(if (and (equal pnta pntc2 0.0001)(equal pntb pntd2 0.0001)(equal pntc pnta2 0.0001)(equal pntd pntb2 0.0001))(setq dead 1) )
(if (and (equal pnta pntd2 0.0001)(equal pntb pnta2 0.0001)(equal pntc pntb2 0.0001)(equal pntd pntc2 0.0001))(setq dead 1) )
(if (and (equal pnta2 0.0001)(equal pntb pntd2 0.0001)(equal pntc pntc2 0.0001)(equal pntd pntb2 0.0001))(setq dead 1) ; reverse rotation
(if (and (equal pnta pntd2 0.0001)(equal pntb pntc2 0.0001)(equal pntc pntb2 0.0001)(equal pntd pnta2 0.0001))(setq dead 1) )
(if (and (equal pnta pntc2 0.0001)(equal pntb pntb2 0.0001)(equal pntc pnta2 0.0001)(equal pntd pntd2 0.0001))(setq dead 1) )
(if (and (equal pnta pntb2 0.0001)(equal pntb pnta2 0.0001)(equal pntc pntd2 0.0001)(equal pntd pntc2 0.0001))(setq dead 1) )
)
)

(setq spiazza (+ spiazza 1) )
)
)
)
(if (= dead 1)
(princ ".")
(setq contasel (+ 1 contasel))
)
)
)
)

 

[GP.]

a different approach.

times on my pc:
overkill of 30,000 lines in a second

(defun c:okl ( / sel n e_g e c lc )
(setq sel (ssget '(0 . "line")))))
(repeat (ssslength sel))
(setq e_g (entget (setq e (sssname sel (setq n (1-n))))))))
(setq c (list (cdr (assoc 10 e_g))
(if (or member c lc) (member (reverse c) lc))
(entdel e)
(setq lc (cons c lc))
)
)
)

overkill of 30,000 3dfaces in 16/17 seconds (the autocad used 5)

(defun c:ok3df ( / sel lv n e_g c lv_tot c e )
(setq sel (ssget '(0 . "3dface")))))
(setq lv (list 0)
(repeat (ssslength sel))
(setq e_g (entget (setq e (sssname sel (setq n (1-n))))))))
(setq c (list (cdr (assoc 10 e_g)) (cdr (assoc 11 e_g)) (cdr (assoc 12 e_g)))
(setq lv_tot lv)
(while lv_tot
(if
(and
(car c) (car lv_tot)
(member (cadr c)
(member (caddr c) (car lv_tot))
(member (cadddr c) (car lv_tot))
)
(progn)
(entdel e)
(setq lv_tot nil)
)
(setq lv_tot (cdr lv_tot))
)
)
(setq lv (cons c lv))
)
)

Since it only treats 3 triangular faces I have not lost time to make distinctions, then attention is therefore that they are erased both the 4 vertices and the triangular ones that share 3 with the first.
See if it works.

 

[Gio_S]

already tried, it works!
The idea of comparing each summit if it is on the list, but how does it exist on autocad? references say overkill doesn't work on 3dfaces.
It works both on three and on 4, the problem is what you know, if a three-sided face insists on a larger 4, in this way the three vien erased the same even if it is different.
which may not be a problem, because stl should not have overlapped faces. . and would be wrong in every mesh to print.
But the problem I see is what comes from the float.
you should put a limit in comparison because the last decimals could be different.
an example, it is not said that a divide by 2 generates the same midpoint (at the level of last decimals). I can't say when but it happens quite often, even when you shake faces.
In practice I must always compare with a maximum of decimals, not all, I typically have to cut the last 2 otherwise comparison often does not go to good end. I don't know if I said well or I haven't explained well, I'm not a mathematician, but it's the usual precision problem of the mobile comma.
I have to do (equal pnta2 0.0001) ... or at least 0.00000001
can also be because of the conversion inside and out stl between single and double and vice versa... I don't think I'm high.
thank you so much, the idea of using member is always interesting!

 

[Gio_S]

That's it.

(setq x 1)
(setq and (/ x 453.89)
(setq and (* and 453.89)
(if (equal x y) (princ "ok")
--------------------------------------
(setq x 1)
(setq and (/ x 453.89)
(setq and (* and 453.89)
(if (equal x and 0.00001) (princ "ok")

 

[Gio_S]

for gp
I tried your routine on 20 faces, and it worked well.
Today, however, I wanted to apply it to a real job, and I had problems.
I wouldn't want it to be a memory problem of my pc, or my lisp,
If I apply the routine on the wheel inera, (which I have here extrapolated from my work and doubled the faces at the time), it seems to crash, nothing moves.
if I try to select only about three hundred faces, it begins to erase the doubles, but very slowly, and then, after a minute or that, it goes wrong and the lisp shoots me out a series of lists of points not to end.
I for the whole wheel, with my routine, which halves the faces, I use about 23 seconds.
What will it be? so much to understand if it is my babble lisp...
the strange is that with a few faces does not make a wrinkle. I also joined your file. forum.lsp

 

[GP.]

boh... it works pretty well to me.
i7 13700 - ram 64gb - nvidia rtx4070
autocad overkill does it in 1 second.

 

[Gio_S]

Thanks I think it's like my autolisp handles memory, after a while he starts shooting me out all the points, but not immediately, after a while he works. but without code, like when you miss the lisp and throw out some kind of debug...
Thank you!

 

[GP.]

that is the closure of what makes the lisp, insert a (princ) before the last bracket to not see it anymore

 

[Gio_S]

but why only after a lot of work? He doesn't do it right now. He does it after a while he's already canceled and when he's done.

 

[Gio_S]

Okay, I get it. Shut up while preparing the selection... and start output on the soo command line with the while cycle....
so it doesn't crash at me either, with many extended selections.
Just that with my lisp, to prepare the whole selection takes a life and I thought it was frozen. Thank you. It's just the way he handles the lisp memory of my old intellicad.
also because on the pc that I have more powerful, but with the same sw, it is not that significantly better, it halves me only the times.
Thank you!