Author Topic: Delete 3D faces that are NOT vertical  (Read 9433 times)

0 Members and 1 Guest are viewing this topic.

Matt__W

  • Seagull
  • Posts: 12955
  • I like my water diluted.
Delete 3D faces that are NOT vertical
« on: September 02, 2015, 03:29:59 PM »
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!!  :)
Autodesk Expert Elite
Revit Subject Matter Expert (SME)
Owner/FAA sUAS Pilot @ http://skyviz.io

DEVITG

  • Bull Frog
  • Posts: 479
Re: Delete 3D faces that are NOT vertical
« Reply #1 on: September 02, 2015, 05:37:57 PM »
Please upload the DWG , or a part of it by WBLOCK , or send me by e-maial to myusernamehere@gmail.com
Location @ Córdoba Argentina Using ACAD 2019  at Window 10

ribarm

  • Gator
  • Posts: 3265
  • Marko Ribar, architect
Re: Delete 3D faces that are NOT vertical
« Reply #2 on: September 02, 2015, 10:20:32 PM »
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.  

Regards, M.R.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

roy_043

  • Water Moccasin
  • Posts: 1895
  • BricsCAD 18
Re: Delete 3D faces that are NOT vertical
« Reply #3 on: September 03, 2015, 06:56:01 AM »
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.     '(lambda (pt)
  22.       (or
  23.         (equal pt ptMain fuzz)
  24.         (and
  25.           (setq pt (trans (mapcar '- pt ptMain) 0 vec)) ; Trans idea inspired by Lee Mac.
  26.           (equal 0.0 (car pt) fuzz)
  27.           (equal 0.0 (cadr pt) fuzz)
  28.         )
  29.       )
  30.     )
  31.     (cdr lst)
  32.   )
  33. )

David Bethel

  • Swamp Rat
  • Posts: 656
Re: Delete 3D faces that are NOT vertical
« Reply #4 on: September 03, 2015, 07:52:37 AM »
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
R12 Dos - A2K

Matt__W

  • Seagull
  • Posts: 12955
  • I like my water diluted.
Re: Delete 3D faces that are NOT vertical
« Reply #5 on: September 03, 2015, 11:22:17 AM »
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!!
Autodesk Expert Elite
Revit Subject Matter Expert (SME)
Owner/FAA sUAS Pilot @ http://skyviz.io

David Bethel

  • Swamp Rat
  • Posts: 656
Re: Delete 3D faces that are NOT vertical
« Reply #6 on: September 03, 2015, 12:05:37 PM »
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.
R12 Dos - A2K

roy_043

  • Water Moccasin
  • Posts: 1895
  • BricsCAD 18
Re: Delete 3D faces that are NOT vertical
« Reply #7 on: September 03, 2015, 12:58:19 PM »
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

  • Swamp Rat
  • Posts: 656
Re: Delete 3D faces that are NOT vertical
« Reply #8 on: September 03, 2015, 03:37:21 PM »
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
R12 Dos - A2K

roy_043

  • Water Moccasin
  • Posts: 1895
  • BricsCAD 18
Re: Delete 3D faces that are NOT vertical
« Reply #9 on: September 03, 2015, 06:46:55 PM »
My code indeed fails on that last one.

roy_043

  • Water Moccasin
  • Posts: 1895
  • BricsCAD 18
Re: Delete 3D faces that are NOT vertical
« Reply #10 on: September 04, 2015, 06:06:52 AM »
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).
« Last Edit: September 04, 2015, 07:52:19 AM by roy_043 »

Lee Mac

  • Seagull
  • Posts: 12913
  • London, England
Re: Delete 3D faces that are NOT vertical
« Reply #11 on: September 04, 2015, 08:39:04 AM »
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.     (equal (car ptLst) (caddr ptLst) fuzz)
  2.     (equal (cadr ptLst) (cadddr ptLst) fuzz)
  3.     (PointListColinear_P ptLst)
  4.   )

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

roy_043

  • Water Moccasin
  • Posts: 1895
  • BricsCAD 18
Re: Delete 3D faces that are NOT vertical
« Reply #12 on: September 04, 2015, 09:28:48 AM »
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.     (equal (car ptLst) (caddr ptLst) fuzz)
  2.     (equal (cadr ptLst) (cadddr ptLst) fuzz)
  3.     (PointListColinear_P ptLst)
  4.   )

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

  • Water Moccasin
  • Posts: 1895
  • BricsCAD 18
Re: Delete 3D faces that are NOT vertical
« Reply #13 on: September 04, 2015, 09:58:30 AM »
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.     '(lambda (pt)
  44.       (or
  45.         (equal pt ptMain fuzz)
  46.         (and
  47.           (setq pt (trans (mapcar '- pt ptMain) 0 vec)) ; Trans idea inspired by Lee Mac.
  48.           (equal 0.0 (car pt) fuzz)
  49.           (equal 0.0 (cadr pt) fuzz)
  50.         )
  51.       )
  52.     )
  53.     (cdr lst)
  54.   )
  55. )

Lee Mac

  • Seagull
  • Posts: 12913
  • London, England
Re: Delete 3D faces that are NOT vertical
« Reply #14 on: September 04, 2015, 01:10:41 PM »
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: