Author Topic: Fast algorithm for finding 3D face boundary?  (Read 220 times)

0 Members and 1 Guest are viewing this topic.

well20152016

  • Newt
  • Posts: 58
Fast algorithm for finding 3D face boundary?
« on: December 03, 2018, 03:12:31 AM »
Fast algorithm for finding 3D face boundary?

David Bethel

  • Swamp Rat
  • Posts: 637
Re: Fast algorithm for finding 3D face boundary?
« Reply #1 on: December 03, 2018, 05:50:42 AM »
Isn't a 3DFACE is a boundary in most instances ???
R12 Dos - A2K

ribarm

  • Water Moccasin
  • Posts: 1935
  • Marko Ribar, architect
Re: Fast algorithm for finding 3D face boundary?
« Reply #2 on: December 03, 2018, 10:02:34 AM »
Hi this is improved version that accepts holes in 3dfaces network and manages to do breaking along boundary - 3DPOLYLINE if user want that... But nevertheless its slow - on my PC it took 920 secsonds for your cca 2500 3dfaces...

Code - Auto/Visual Lisp: [Select]
  1. (defun c:3dpolysaround3dfaces ( / vl-position-fuzz car-vl-member-if unique uniquepl osm pdm pds ss ti i 3df pl pll plll el ell elll k z p1 p2 3dppl ch pp ppl pos1 pos2 ppp 3dppls p )
  2.  
  3.  ;; (vl-position-fuzz 3.29 '(1.1 2.2 3.3 4.4 5.5 6.6 7.7 8.8 9.9) 0.01) => 2 ;;
  4.  (defun vl-position-fuzz ( e l fuzz / car-vl-member-if )
  5.    (defun car-vl-member-if ( f l / ff r )
  6.      (setq ff '(lambda ( x ) (if (apply f (list x)) (setq r x))))
  7.      (vl-some ff l)
  8.      r
  9.    )
  10.    (vl-position (car-vl-member-if '(lambda ( x ) (equal e x fuzz)) l) l)
  11.  )
  12.  
  13.  (defun car-vl-member-if ( f l / ff r )
  14.    (setq ff '(lambda ( x ) (if (apply f (list x)) (setq r x))))
  15.    (vl-some ff l)
  16.    r
  17.  )
  18.  
  19.  (defun unique ( l )
  20.    (if l (cons (car l) (unique (vl-remove-if '(lambda ( x )
  21.      (and
  22.        (vl-some '(lambda ( y ) (equal y (car (car l)) 1e-6)) x)
  23.        (vl-some '(lambda ( y ) (equal y (cadr (car l)) 1e-6)) x)
  24.        (vl-some '(lambda ( y ) (equal y (caddr (car l)) 1e-6)) x)
  25.        (vl-some '(lambda ( y ) (equal y (cadddr (car l)) 1e-6)) x)
  26.      )) l))))
  27.  )
  28.  
  29.  (defun uniquepl ( l )
  30.    (if l (cons (car l) (uniquepl (vl-remove-if '(lambda ( x ) (equal x (car l) 1e-6)) l))))
  31.  )
  32.  
  33.  (setq osm (getvar 'osmode))
  34.  (setq pdm (getvar 'pdmode))
  35.  (setq pds (getvar 'pdsize))
  36.  (setvar 'pdmode 35)
  37.  (setvar 'pdsize -1.5)
  38.  (prompt "\nSelect 3DFACE entities to process...")
  39.  (setq ss (ssget '((0 . "3DFACE"))))
  40.  (if ss
  41.    (progn
  42.      (setq ti (car (_vl-times)))
  43.      (repeat (setq i (sslength ss))
  44.        (setq 3df (ssname ss (setq i (1- i))))
  45.        (setq pl (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (vl-position (car x) '(10 11 12 13))) (entget 3df))))
  46.        (setq pll (cons pl pll))
  47.      )
  48.      (setq plll (vl-remove-if '(lambda ( x ) (<= (length (uniquepl x)) 2)) pll))
  49.      (setq plll (unique plll))
  50.      (foreach pl plll
  51.        (setq el (mapcar '(lambda ( a b ) (list a b)) pl (cdr (reverse (cons (car pl) (reverse pl))))))
  52.        (setq ell (append el ell))
  53.      )
  54.      (setq ell (vl-remove-if '(lambda ( x ) (equal (apply 'distance x) 0.0 1e-6)) ell))
  55.      (setq k -1 elll ell)
  56.      (foreach e1 ell
  57.        (setq k (1+ k) z nil)
  58.        (foreach e2 (vl-remove nil (mapcar '(lambda ( x ) (if (null z) (setq z 0) (setq z (1+ z))) (if (/= k z) x)) ell))
  59.          (if (or (equal e1 e2 1e-6) (equal e1 (reverse e2) 1e-6))
  60.            (setq elll (vl-remove e1 elll))
  61.          )
  62.        )
  63.      )
  64.      (while elll
  65.        (setq el (car elll))
  66.        (setq p1 (car el) p2 (cadr el))
  67.        (setq 3dppl (cons p1 3dppl))
  68.        (setq elll (cdr elll))
  69.        (while (setq el (car-vl-member-if '(lambda ( x ) (or (equal p2 (car x) 1e-6) (equal p2 (cadr x) 1e-6))) elll))
  70.          (if (equal (car el) p2 1e-6)
  71.            (setq p1 (car el) p2 (cadr el))
  72.            (setq p1 (cadr el) p2 (car el))
  73.          )
  74.          (setq elll (vl-remove el elll))
  75.          (setq 3dppl (cons p1 3dppl))
  76.        )
  77.        (prompt "\nPRESS ANY KEY TO CONTINUE...")
  78.        (vl-catch-all-apply 'grread)
  79.        (foreach p 3dppl
  80.          (setq pp (entmakex (list '(0 . "POINT") (cons 10 p))))
  81.          (redraw pp 3)
  82.          (vl-cmdf "_.DELAY" 100)
  83.          (entdel pp)
  84.        )
  85.        (initget "Yes No")
  86.        (setq ch (getkword "\nPick breaking points in shown direction or draw closed 3DPOLYLINE [Yes/No] <Yes> : "))
  87.        (if (null ch)
  88.          (setq ch "Yes")
  89.        )
  90.        (if (= ch "Yes")
  91.          (progn
  92.            (setvar 'osmode 1)
  93.            (while (setq pp (getpoint "\nPick or specify breaking point - ENTER TO FINISH (at least 2 points on contour must be specified in shown direction) : "))
  94.              (setq ppl (cons pp ppl))
  95.            )
  96.            (setq ppl (reverse ppl))
  97.            (setq 3dppl (append 3dppl 3dppl))
  98.            (setq ppl (mapcar '(lambda ( a b ) (list a b)) ppl (cdr (reverse (cons (car ppl) (reverse ppl))))))
  99.            (foreach pp ppl
  100.              (setq pos1 (vl-position-fuzz (car pp) 3dppl 1e-6) pos2 (vl-position-fuzz (cadr pp) 3dppl 1e-6) k -1)
  101.              (if (< pos2 pos1)
  102.                (setq pos2 (+ pos2 (vl-position-fuzz (cadr pp) (cdr (vl-member-if '(lambda ( x ) (equal x (cadr pp) 1e-6)) 3dppl)) 1e-6) 1))
  103.              )
  104.              (foreach p 3dppl
  105.                (setq k (1+ k))
  106.                (if (<= pos1 k pos2)
  107.                  (setq ppp (cons p ppp))
  108.                )
  109.              )
  110.              (setq 3dppls (cons ppp 3dppls))
  111.              (setq ppp nil)
  112.            )
  113.            (foreach ppp 3dppls
  114.              (vl-cmdf "_.3DPOLY")
  115.              (foreach p ppp
  116.                (vl-cmdf "_non" p)
  117.              )
  118.              (vl-cmdf "")
  119.            )
  120.            (setq 3dppl nil 3dppls nil ppl nil)
  121.          )
  122.          (progn
  123.            (setq 3dppl (cons p2 3dppl))
  124.            (vl-cmdf "_.3DPOLY")
  125.            (foreach p 3dppl
  126.              (vl-cmdf "_non" p)
  127.            )
  128.            (vl-cmdf "_C")
  129.            (setq 3dppl nil)
  130.          )
  131.        )
  132.      )
  133.    )
  134.  )
  135.  (setvar 'osmode osm)
  136.  (setvar 'pdmode pdm)
  137.  (setvar 'pdsize pds)
  138.  (prompt "\nElapsed time : ") (princ (rtos (/ (- (car (_vl-times)) ti) 1000.0) 2 50)) (prompt " seconds...")
  139.  (princ)
  140. )
  141.  

For more info, serach this topic...
https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/draw-3dpoly-in-3dfaces/m-p/7789616#M365239

Regards, M.R.
P.S. You could ask someone that work in .NET or ObjectARX like nullptr-aka Daniel to convert this lisp to something faster as it's not fast algorithm at all...
But it's LISP and you can understand it...
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

well20152016

  • Newt
  • Posts: 58
Re: Fast algorithm for finding 3D face boundary?
« Reply #3 on: December 03, 2018, 11:01:23 PM »
Thank you!