Draw 3dpoly in 3dfaces

[carlos_m_gil_p]

Hello how are you.

They could help me with these.

I want to select a set of 3dfaces and have a 3dpoly drawn around the selection.

I attach an example.

Beforehand thank you very much.

Excuse my English, I only speak Spanish.

[CodeDing]

Are you using AutoCAD Civil 3D?

If you are not then what you are asking would require a large amount of coding, to my knowledge.

With AutoCAD Civil 3D you can add the 3D faces to a surface and create a boundary.

Sorry I can't help more at the moment.

Best,

~DD

[carlos_m_gil_p]

Hello CodeDing how are you?

Thanks for answering.

Currently I use is AutoCAD.

I thought it would be easy.

How to extract the vertices and draw.

Well, I'll wait, in case someone has something similar.

Thank you.

[marko_ribar · Accepted solution]

Hi Carlos, here you are :

(defun c:3dpolyaround3dfaces ( / car-vl-member-if unique uniquepl ss i 3df pl pll plll el ell elll k z p1 p2 3dppl )

  (defun car-vl-member-if ( f l / ff r )
    (setq ff '(lambda ( x ) (if (apply f (list x)) (setq r x))))
    (if (vl-some ff l)
      r
    )
  )

  (defun unique ( l )
    (if l (cons (car l) (unique (vl-remove-if '(lambda ( x )
      (and
        (vl-some '(lambda ( y ) (equal y (car (car l)) 1e-6)) x)
        (vl-some '(lambda ( y ) (equal y (cadr (car l)) 1e-6)) x)
        (vl-some '(lambda ( y ) (equal y (caddr (car l)) 1e-6)) x)
        (vl-some '(lambda ( y ) (equal y (cadddr (car l)) 1e-6)) x)
      )) l))))
  )

  (defun uniquepl ( l )
    (if l (cons (car l) (uniquepl (vl-remove-if '(lambda ( x ) (equal x (car l) 1e-6)) l))))
  )

  (prompt "\nSelect 3DFACE entities to process...")
  (setq ss (ssget '((0 . "3DFACE"))))
  (if ss
    (progn
      (repeat (setq i (sslength ss))
        (setq 3df (ssname ss (setq i (1- i))))
        (setq pl (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (vl-position (car x) '(10 11 12 13))) (entget 3df))))
        (setq pll (cons pl pll))
      )
      (setq plll (vl-remove-if '(lambda ( x ) (<= (length (uniquepl x)) 2)) pll))
      (setq plll (unique plll))
      (foreach pl plll
        (setq el (mapcar '(lambda ( a b ) (list a b)) pl (cdr (reverse (cons (car pl) (reverse pl))))))
        (setq ell (append el ell))
      )
      (setq ell (vl-remove-if '(lambda ( x ) (equal (apply 'distance x) 0.0 1e-6)) ell))
      (setq k -1 elll ell)
      (foreach e1 ell
        (setq k (1+ k) z nil)
        (foreach e2 (vl-remove nil (mapcar '(lambda ( x ) (if (null z) (setq z 0) (setq z (1+ z))) (if (/= k z) x)) ell))
          (if (or (equal e1 e2 1e-6) (equal e1 (reverse e2) 1e-6))
            (setq elll (vl-remove e1 elll))
          )
        )
      )
      (setq el (car elll))
      (setq p1 (car el) p2 (cadr el))
      (setq 3dppl (cons p1 3dppl))
      (setq elll (cdr elll))
      (while (setq el (car-vl-member-if '(lambda ( x ) (or (equal p2 (car x) 1e-6) (equal p2 (cadr x) 1e-6))) elll))
        (if (equal (car el) p2 1e-6)
          (setq p1 (car el) p2 (cadr el))
          (setq p1 (cadr el) p2 (car el))
        )
        (setq elll (vl-remove el elll))
        (setq 3dppl (cons p1 3dppl))
      )
      (setq 3dppl (cons p2 3dppl))
      (vl-cmdf "_.3DPOLY")
      (foreach p 3dppl
        (vl-cmdf "_non" p)
      )
      (vl-cmdf "_C")
    )
  )
  (princ)
)

(defun c:3pa3f nil (c:3dpolyaround3dfaces))

HTH., M.R.

[marko_ribar]

@carlos_m_gil_p

Is something wrong with my code... It works for me and I think it's the solution to your asked question... Are you OK, why you wait to mark solution, are you expecting something else? We need your feedback...

[carlos_m_gil_p]

Hello Marko. I do not have internet at home. tomorrow I review it. forgive my delay.

[carlos_m_gil_p]

Hello Marko.

I can not find the exact words, to tell you how grateful I am.

It works very well.

The only thing I see is that it is very slow.
I do not know if that can be improved.

Another thing I see is that in cones, only draw the top ring.

I attached a file with a cone.

In case you want to see it.

Add a time function to the code to see how long it really takes.

And modify a line of the code, so that the 3d polyline was not closed.

(defun c:3dpolyaround3dfaces  (/ car-vl-member-if unique uniquepl ss i 3df pl pll plll el ell elll k z p1 p2 3dppl tiempo)
  (defun car-vl-member-if  (f l / ff r)
    (setq ff '(lambda (x)
		(if (apply f (list x))
		  (setq r x))))
    (if	(vl-some ff l)
      r))
  (defun unique	 (l)
    (if	l
      (cons (car l)
	    (unique (vl-remove-if
		      '(lambda (x)
			 (and (vl-some '(lambda (y) (equal y (car (car l)) 1e-6)) x)
			      (vl-some '(lambda (y) (equal y (cadr (car l)) 1e-6)) x)
			      (vl-some '(lambda (y) (equal y (caddr (car l)) 1e-6)) x)
			      (vl-some '(lambda (y) (equal y (cadddr (car l)) 1e-6)) x)))
		      l)))))
  (defun uniquepl  (l)
    (if	l
      (cons (car l) (uniquepl (vl-remove-if '(lambda (x) (equal x (car l) 1e-6)) l)))))
  (prompt "\nSelect 3DFACE entities to
process...")
  (setq ss (ssget '((0 . "3DFACE"))))
  (if ss
    (progn ;; Add
	   (setq tiempo (getvar "millisecs"))
	   ;;
	   (repeat (setq i (sslength ss))
	     (setq 3df (ssname ss (setq i (1- i))))
	     (setq pl (mapcar 'cdr (vl-remove-if-not '(lambda (x) (vl-position (car x) '(10 11 12 13))) (entget 3df))))
	     (setq pll (cons pl pll)))
	   (setq plll (vl-remove-if '(lambda (x) (<= (length (uniquepl x)) 2)) pll))
	   (setq plll (unique plll))
	   (foreach pl	plll
	     (setq el (mapcar '(lambda (a b) (list a b)) pl (cdr (reverse (cons (car pl) (reverse pl))))))
	     (setq ell (append el ell)))
	   (setq ell (vl-remove-if '(lambda (x) (equal (apply 'distance x) 0.0 1e-6)) ell))
	   (setq k    -1
		 elll ell)
	   (foreach e1	ell
	     (setq k (1+ k)
		   z nil)
	     (foreach e2  (vl-remove nil
				     (mapcar '(lambda (x)
						(if (null z)
						  (setq z 0)
						  (setq z (1+ z)))
						(if (/= k z)
						  x))
					     ell))
	       (if (or (equal e1 e2 1e-6) (equal e1 (reverse e2) 1e-6))
		 (setq elll (vl-remove e1 elll)))))
	   (setq el (car elll))
	   (setq p1 (car el)
		 p2 (cadr el))
	   (setq 3dppl (cons p1 3dppl))
	   (setq elll (cdr elll))
	   (while (setq el (car-vl-member-if '(lambda (x) (or (equal p2 (car x) 1e-6) (equal p2 (cadr x) 1e-6))) elll))
	     (if (equal (car el) p2 1e-6)
	       (setq p1	(car el)
		     p2	(cadr el))
	       (setq p1	(cadr el)
		     p2	(car el)))
	     (setq elll (vl-remove el elll))
	     (setq 3dppl (cons p1 3dppl)))
	   (setq 3dppl (cons p2 3dppl))
	   (vl-cmdf "_.3DPOLY")
	   (foreach p 3dppl (vl-cmdf "_non" p))
	   ;; Mod
	   (tmp-ejec tiempo)
	   (vl-cmdf "_non" "")
	   ;;
	   ))
  (princ))
(defun c:3pa3f nil (c:3dpolyaround3dfaces))

;;; Tiempo

(defun tmp-ejec	 (tmp)
  (princ
    (strcat "\nTiempo de ejecucion: " (rtos (/ (- (getvar "millisecs") tmp) 1000.0) 2 2) " Segundos.")))

Thank you.

[marko_ribar]

Hi Carlos, you should cap top hole of cone with closed LWPOLYLINE and then triangulate its area with 3DFACES... Note that if you want contour around 3DFACES, you should apply my routine to unique area of 3DFACES - there should be no holes... For triangulation of LWPOLYLINE polygon you could use something like this :

(defun c:triangulatepolygon-3dfaces ( / trianglst lw ptlst )

  (vl-load-com)

  (defun trianglst ( ptlst / unique LM:ListClockwise-p clockwise-p l p1 p2 p3 trl )

    (defun unique ( l )
      (if l (cons (car l) (unique (vl-remove-if (function (lambda ( x ) (equal x (car l) 1e-6))) l))))
    )

    ;; List Clockwise-p - Lee Mac
    ;; Returns T if the point list is clockwise oriented

    (defun LM:ListClockwise-p ( lst )
      (minusp
        (apply '+
          (mapcar
            (function
              (lambda ( a b )
                (- (* (car b) (cadr a)) (* (car a) (cadr b)))
              )
            )
            lst (cons (last lst) lst)
          )
        )
      )
    )

    (defun clockwise-p ( p1 p2 p3 )
      (< (* (- (car  p2) (car  p1)) (- (cadr p3) (cadr p1)))
         (* (- (cadr p2) (cadr p1)) (- (car  p3) (car  p1)))
      )
    )

    (setq l ptlst)
    (while (> (length ptlst) 3)
      (setq p1 (car ptlst) p2 (cadr ptlst) p3 (caddr ptlst))
      (cond
        ( (LM:ListClockwise-p ptlst)
          (if
            (and
              (clockwise-p p1 p2 p3)
              (= (length (unique (vl-remove nil (mapcar (function (lambda ( a b ) (inters p1 p2 a b))) l (cdr (reverse (cons (car l) (reverse l)))))))) 2)
              (= (length (unique (vl-remove nil (mapcar (function (lambda ( a b ) (inters p2 p3 a b))) l (cdr (reverse (cons (car l) (reverse l)))))))) 2)
              (= (length (unique (vl-remove nil (mapcar (function (lambda ( a b ) (inters p3 p1 a b))) l (cdr (reverse (cons (car l) (reverse l)))))))) 2)
            )
            (progn
              (setq trl (cons (list p1 p2 p3) trl))
              (setq ptlst (vl-remove p2 ptlst))
              (setq ptlst (cdr (reverse (cons (car ptlst) (reverse ptlst)))))
            )
            (setq ptlst (cdr (reverse (cons (car ptlst) (reverse ptlst)))))
          )
        )
        ( (not (LM:ListClockwise-p ptlst))
          (if
            (and
              (not (clockwise-p p1 p2 p3))
              (= (length (unique (vl-remove nil (mapcar (function (lambda ( a b ) (inters p1 p2 a b))) l (cdr (reverse (cons (car l) (reverse l)))))))) 2)
              (= (length (unique (vl-remove nil (mapcar (function (lambda ( a b ) (inters p2 p3 a b))) l (cdr (reverse (cons (car l) (reverse l)))))))) 2)
              (= (length (unique (vl-remove nil (mapcar (function (lambda ( a b ) (inters p3 p1 a b))) l (cdr (reverse (cons (car l) (reverse l)))))))) 2)
            )
            (progn
              (setq trl (cons (list p1 p2 p3) trl))
              (setq ptlst (vl-remove p2 ptlst))
              (setq ptlst (cdr (reverse (cons (car ptlst) (reverse ptlst)))))
            )
            (setq ptlst (cdr (reverse (cons (car ptlst) (reverse ptlst)))))
          )
        )
      )
    )
    (setq trl (cons (list (car ptlst) (cadr ptlst) (caddr ptlst)) trl))
    trl
  )

  (while (or (not (setq lw (car (entsel "\nPick LWPOLYLINE closed polygon to triangulate...")))) (if lw (or (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getstartpoint (list lw))) (/= (cdr (assoc 0 (entget lw))) "LWPOLYLINE") (/= 1 (logand 1 (cdr (assoc 70 (entget lw))))))))
    (prompt "\nMissed or picked wrong entity type")
  )
  (setq ptlst (mapcar '(lambda ( p ) (trans p lw 0)) (mapcar '(lambda ( p ) (list (car p) (cadr p) (cdr (assoc 38 (entget lw))))) (mapcar 'cdr (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (entget lw))))))
  (foreach tr (trianglst ptlst)
    (entmake
      (list
        '(0 . "3DFACE")
        (cons 10 (car tr))
        (cons 11 (car tr))
        (cons 12 (cadr tr))
        (cons 13 (caddr tr))
      )
    )
  )
  (princ)
)

P.S. In attachment is your DWG with 3dpolyline contour around conic 3DFACES model... You could leave - close option at the end and after that if you want it to be open curve, just select it, go to properties palette and change from closed "Yes" to "No"...

Regards, M.R.

[carlos_m_gil_p]

Hello Brother how are you.
Everything works very well.
It always takes a while when there are many triangles, but it works very well.

With all my heart, thank you very much.
Greetings.