Topic: Delete 3D faces that are NOT vertical

[Matt__W]

Can someone whip something together that will delete all non-vertical 3D faces? I'm being lazy and don't want to have to manually delete the 10's of 1000's of 3D faces in this drawing. K'thanks!! 

[DEVITG]

Please upload the DWG , or a part of it by WBLOCK , or send me by e-maial to myusernamehere@gmail.com

[ribarm]

If I understood correctly :

Code - Auto/Visual Lisp: [Select]

1. (defun c:delnonvert3Dfaces ( / unit v^v ss fuzz i 3DF p1 p2 p3 )
2.  
3.   (defun unit ( v )
4.     (mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)
5.   )
6.  
7.   (defun v^v ( u v )
8.     (mapcar '(lambda ( s1 s2 a b ) (+ ((eval s1) (* (nth a u) (nth b v))) ((eval s2) (* (nth a v) (nth b u))))) '(+ - +) '(- + -) '(1 0 0) '(2 2 1))
9.   )
10.  
11.   (prompt "\nSelect 3DFACES...")
12.   (setq ss (ssget "_:L" '((0 . "3DFACE"))))
13.   (while (not ss)
14.     (prompt "\nEmpty sel.set... Please select 3DFACES on unlocked layer(s) again...")
15.     (setq ss (ssget "_:L" '((0 . "3DFACE"))))
16.   )
17.   (initget 6)
18.   (setq fuzz (getdist "\nSpecify fuzz factor for stepping off from absolute verticallity (Z coordinate of normal 3DFACE unit vector = 0.0 - fuzz) <1e-4> : "))
19.   (if (null fuzz) (setq fuzz 1e-4))
20.   (repeat (setq i (sslength ss))
21.     (setq 3DF (ssname ss (setq i (1- i))))
22.     (setq p1 (cdr (assoc 10 (entget 3DF))))
23.     (setq p2 (cdr (assoc 11 (entget 3DF))))
24.     (setq p3 (cdr (assoc 12 (entget 3DF))))
25.     (setq p4 (cdr (assoc 13 (entget 3DF))))
26.     (if (equal p1 p2 1e-6) (setq p1 p2 p2 p3 p3 p4 p4 nil))
27.     (if (equal p2 p3 1e-6) (setq p3 p4 p4 nil))
28.     (if (equal p3 p4 1e-6) (setq p4 nil))
29.     (if (equal p1 p4 1e-6) (setq p4 nil))
30.     (if (not (equal (caddr (unit (v^v (mapcar '- p3 p1) (mapcar '- p2 p1)))) 0.0 fuzz))
31.       (entdel 3DF)
32.     )
33.   )
34.   (princ)
35. )
36.  
37. (defun c:dnv3df nil (c:delnonvert3Dfaces))
38. (prompt "\nExecute routine with Command: dnv3df")
39. (princ)
40.  

Regards, M.R.

[roy_043]

Alternative approach: Project the coordinates on the XY plane and check for collinearity:

Code - Auto/Visual Lisp: [Select]

1. ; (3DfaceVertical_P (vlax-ename->vla-object (car (entsel))))
2. (defun 3DfaceVertical_P (obj / ptLst)
3.   (PointListColinear_P
4.     (mapcar
5.       '(lambda (idx) (reverse (cdr (reverse (vlax-get obj 'coordinate idx)))))
6.       '(0 1 2 3)
7.     )
8.   )
9. )
10.  
11. (defun PointListColinear_P (lst / fuzz ptMain vec)
12.   (setq fuzz 1e-8)
13.   (setq ptMain (car lst))
14.   (setq lst
15.     (vl-sort
16.       (cdr lst)
17.       '(lambda (ptA ptB) (> (distance ptA ptMain) (distance ptB ptMain)))
18.     )
19.   )
20.   (setq vec (mapcar '- (car lst) ptMain))
21.   (vl-every
22.     '(lambda (pt)
23.       (or
24.         (equal pt ptMain fuzz)
25.         (and
26.           (setq pt (trans (mapcar '- pt ptMain) 0 vec)) ; Trans idea inspired by Lee Mac.
27.           (equal 0.0 (car pt) fuzz)
28.           (equal 0.0 (cadr pt) fuzz)
29.         )
30.       )
31.     )
32.     (cdr lst)
33.   )
34. )

[David Bethel]

If all that is required is that the Z axis value of the face normal must be 0 in order to be vertical :

Then this should work :

Code - Auto/Visual Lisp: [Select]

1. (defun c:vface (/ ss i en ed f1 f2)
2.  
3. ;;;3 Points To 210 Extrution Direction (LeeMac)
4. (defun normal ( p1 p2 p3 )
5.   (defun vxs ( v s )
6.     (mapcar '(lambda ( n ) (* n s)) v))
7.   (defun nrm ( v )
8.     (sqrt (apply '+ (mapcar '(lambda ( n ) (* n n)) v))))
9.   (defun one ( v )
10.     (vxs v (/ 1.0 (nrm v))))
11.   (defun vcv ( u v )
12.     (list
13.       (- (* (cadr u) (caddr v)) (* (cadr v) (caddr u)))
14.       (- (* (car  v) (caddr u)) (* (car  u) (caddr v)))
15.       (- (* (car  u) (cadr  v)) (* (car  v) (cadr  u)))))
16.   (one (vcv (mapcar '- p3 p2) (mapcar '- p3 p1))))
17.  
18. (defun round (value to)
19.     (setq to (abs to))
20.     (* to (fix (/ ((if (minusp value) - +) value (* to 0.5)) to))))
21.  
22.   (and (setq ss (ssget "X" '((0 . "3DFACE"))))
23.        (setq i 0)
24.        (while (setq en (ssname ss i))
25.               (setq ed (entget en))
26.               (foreach g '(10 11 12 13)
27.                    (set (read (strcat "P" (itoa g)))
28.                         (cdr (assoc g ed))))
29.               (if (and (not (equal p10 p11 1e-4))
30.                        (not (equal p10 p12 1e-4))
31.                        (not (equal p11 p12 1e-4)))
32.                   (setq f1 (round (caddr (normal p10 p11 p12)) 1e-4))
33.                   (setq f1 0.0))
34.               (if (and (not (equal p10 p11 1e-4))
35.                        (not (equal p10 p13 1e-4))
36.                        (not (equal p11 p13 1e-4)))
37.                   (setq f2 (round (caddr (normal p10 p11 p13)) 1e-4))
38.                   (setq f2 0.0))
39.               (and (not (zerop f1))
40.                    (not (zerop f2))
41.                    (entdel en))
42.               (setq i (1+ i))))
43.   (redraw)
44.   (prin1))
45.  

This should work with 3 point faces as well.  Otherwise you would get a divide by zero error.

-David


Looks like this is close to ribarm's approach as well

[Matt__W]

If all that is required is that the Z axis value of the face normal must be 0 in order to be vertical :

Then this should work :

Worked like a champ!  Thanks!!  Much appreciated!!

[David Bethel]

I'm sure there scenarios where faces will crash the normal

Code: [Select]

(entmake (list (cons 0 "3DFACE")(cons 8 "0")(cons 62 5)(cons 10 (list 6 3 18))(cons 11 (list 3 3 14))(cons 12 (list 6 3 14))(cons 13 (list 6 3 22))))
(entmake (list (cons 0 "3DFACE")(cons 8 "0")(cons 62 1)(cons 10 (list 13 3 23))(cons 11 (list 13 3 18))(cons 12 (list 13 3 14))(cons 13 (list 8 3 14))))

points that are colinear : not coplaner etc.

[roy_043]

I'm sure there scenarios where faces will crash the normal

Code: [Select]

(entmake (list (cons 0 "3DFACE")(cons 8 "0")(cons 62 5)(cons 10 (list 6 3 18))(cons 11 (list 3 3 14))(cons 12 (list 6 3 14))(cons 13 (list 6 3 22))))
(entmake (list (cons 0 "3DFACE")(cons 8 "0")(cons 62 1)(cons 10 (list 13 3 23))(cons 11 (list 13 3 18))(cons 12 (list 13 3 14))(cons 13 (list 8 3 14))))

points that are colinear : not coplaner etc.

In those two 'entmake' cases the method I have proposed will work.

[David Bethel]

Maybe this one, although I don't know if I would consider this vertical

Code: [Select]

(entmake (list (cons 0 "3DFACE")(cons 8 "0")(cons 10 (list 0 0 0))(cons 11 (list 12 0 6))(cons 12 (list 0 0 12))(cons 13 (list 0 12 6))))

There are no DXF specifications as to which 2 vertices comprise the "crease" in a folded 3dface  (10 12) or (11 13)

-David

[roy_043]

My code indeed fails on that last one.

[roy_043]

To catch David's last case:

Code - Auto/Visual Lisp: [Select]

1. ; (3DfaceVertical_P (vlax-ename->vla-object (car (entsel))))
2. (defun 3DfaceVertical_P (obj / fuzz ptLst)
3.   (setq fuzz 1e-8)
4.   (setq ptLst
5.     (mapcar
6.       '(lambda (idx) (reverse (cdr (reverse (vlax-get obj 'coordinate idx)))))
7.       '(0 1 2 3)
8.     )
9.   )
10.   (or
11.     (equal (car ptLst) (caddr ptLst) fuzz)
12.     (equal (cadr ptLst) (cadddr ptLst) fuzz)
13.     (PointListColinear_P ptLst)
14.   )
15. )

Edit: Simplified. Removed (vl-some).

[Lee Mac]

Code - Auto/Visual Lisp: [Select]

1. (vlax-get obj 'coordinate idx)

As far as I am aware vlax-get/vlax-get-property can only accept two arguments in AutoCAD - I get a 'too many arguments' error for the above.

Code - Auto/Visual Lisp: [Select]

1. (or
2.     (equal (car ptLst) (caddr ptLst) fuzz)
3.     (equal (cadr ptLst) (cadddr ptLst) fuzz)
4.     (PointListColinear_P ptLst)
5.   )

Wouldn't this incorrectly report David's example as being vertical?

[roy_043]

Code - Auto/Visual Lisp: [Select]

1. (vlax-get obj 'coordinate idx)

As far as I am aware vlax-get/vlax-get-property can only accept two arguments in AutoCAD - I get a 'too many arguments' error for the above.

There is no error in BricsCAD. So in AutoCAD you have to use (vla-get-coordinate obj idx) and then translate the return. Needless to say I prefer the BricsCAD implementation.

Code - Auto/Visual Lisp: [Select]

1. (or
2.     (equal (car ptLst) (caddr ptLst) fuzz)
3.     (equal (cadr ptLst) (cadddr ptLst) fuzz)
4.     (PointListColinear_P ptLst)
5.   )

Wouldn't this incorrectly report David's example as being vertical?

As David hinted, it depends what you consider vertical. The 3D face in David's last contribution has a vertical crease. Therefore the surfaces on both sides of the crease are vertical. But it is a strange face.
Another issue: My code also calls a 3D face with all points on the same line in the XY plane vertical.

[roy_043]

New version. Code now checks that the 3D face has a surface.

Code - Auto/Visual Lisp: [Select]

1. (defun _List_LastRemove (lst)
2.   (reverse (cdr (reverse lst)))
3. )
4.  
5. ; (3DfaceVertical_P (vlax-ename->vla-object (car (entsel))))
6. (defun 3DfaceVertical_P (obj / fuzz ptLst)
7.   (setq fuzz 1e-8)
8.   (setq ptLst
9.     (mapcar
10.       '(lambda (idx)
11.         (vlax-safearray->list
12.           (vlax-variant-value
13.             (vla-get-coordinate obj idx)
14.           )
15.         )
16.       )
17.       '(0 1 2 3)
18.     )
19.   )
20.   (and
21.     (not (equal (car ptLst) (caddr ptLst) fuzz))   ; No surface.
22.     (not (equal (cadr ptLst) (cadddr ptLst) fuzz)) ; No surface.
23.     (not (PointListColinear_P ptLst))              ; No surface.
24.     (setq ptLst (mapcar '_List_LastRemove ptLst))  ; Project the points.
25.     (or
26.       (equal (car ptLst) (caddr ptLst) fuzz)
27.       (equal (cadr ptLst) (cadddr ptLst) fuzz)
28.       (PointListColinear_P ptLst)
29.     )
30.   )
31. )
32.  
33. (defun PointListColinear_P (lst / fuzz ptMain vec)
34.   (setq fuzz 1e-8)
35.   (setq ptMain (car lst))
36.   (setq lst
37.     (vl-sort
38.       (cdr lst)
39.       '(lambda (ptA ptB) (> (distance ptA ptMain) (distance ptB ptMain)))
40.     )
41.   )
42.   (setq vec (mapcar '- (car lst) ptMain))
43.   (vl-every
44.     '(lambda (pt)
45.       (or
46.         (equal pt ptMain fuzz)
47.         (and
48.           (setq pt (trans (mapcar '- pt ptMain) 0 vec)) ; Trans idea inspired by Lee Mac.
49.           (equal 0.0 (car pt) fuzz)
50.           (equal 0.0 (cadr pt) fuzz)
51.         )
52.       )
53.     )
54.     (cdr lst)
55.   )
56. )

[Lee Mac]

Wouldn't this incorrectly report David's example as being vertical?

The 3D face in David's last contribution has a vertical crease. Therefore the surfaces on both sides of the crease are vertical.

I receive a horizontal crease when evaluating the entmake expression: