3d Faces down to zero level

[carlos_m_gil_p]

Hello.

What I want is to lose all 3D faces at zero.

All 3DFaces will always be together.

All 3DFaces always drawn in the same direction.

My lisp, place all 3D faces in zero.
But it does not united.

Thank you.

[marko_ribar]

Here, I'll attach lisp and DWG explaining limitations of lisp...

HTH, M.R.

(I don't think this can be much better, so if you're satisfied with result mark this topic as solved...)

(defun c:xxx ( / *error* LM:int-ci-ci LM:Clockwise-p commonel unique _vl-position unit acos angle3d *tol* osm f ss p ip es esal espl k esdl 3dfpl 3dfplr 3dfdlr 3dfalr tmp tmp3dfdlr n nl esplp an 3dfplp n3dfpl n3dfdl n3dfal n3dfplp p1 p2 r1 r2 p3l p3 p3s p1p p2p p3p ptdptl1 ptdptll ptdptlpp p1dl p1pdl ptdptl1p d1 p1dp2l1 ptdptl d p1dp2l ptdptlp p1dp2lp kk kkk )

  (defun *error* ( m )
    (if osm (setvar 'osmode osm))
    (if f (command "_.UCS" "_P"))
    (if m (prompt m))
    (princ)
  )

  ;; 2-Circle Intersection (trans version)  -  Lee Mac
  ;; Returns the point(s) of intersection between two circles
  ;; with centres c1,c2 and radii r1,r2

  (defun LM:int-ci-ci ( c1 r1 c2 r2 / *n* *d1* *x* *z* )
    (if
      (and
        (< (setq *d1* (distance c1 c2)) (+ r1 r2))
        (< (abs (- r1 r2)) *d1*)
      )
      (progn
        (setq *n* (mapcar '- c2 c1))
        (setq c1 (trans c1 0 *n*))
        (setq *z* (/ (- (+ (* r1 r1) (* *d1* *d1*)) (* r2 r2)) (+ *d1* *d1*)))
        (if (equal *z* r1 1e-8)
          (list (trans (list (car c1) (cadr c1) (+ (caddr c1) *z*)) *n* 0))
          (progn
            (setq *x* (sqrt (- (* r1 r1) (* *z* *z*))))
            (list
              (trans (list (- (car c1) *x*) (cadr c1) (+ (caddr c1) *z*)) *n* 0)
              (trans (list (+ (car c1) *x*) (cadr c1) (+ (caddr c1) *z*)) *n* 0)
            )
          )
        )
      )
    )
  )

  ;; Clockwise-p  -  Lee Mac
  ;; Returns T if p1,p2,p3 are clockwise oriented or collinear

  (defun LM:Clockwise-p ( p1 p2 p3 )
    (< (-  (* (- (car  p2) (car  p1)) (- (cadr p3) (cadr p1)))
           (* (- (cadr p2) (cadr p1)) (- (car  p3) (car  p1)))
       )
       1e-8
    )
  )

  (defun commonel ( l1 l2 / *tol* r )
    (or *tol* (setq *tol* 1e-6))
    (foreach e l1
      (if (vl-member-if '(lambda ( x ) (equal e x *tol*)) l2)
        (setq r e)
      )
    )
    r
  )

  (defun unique ( l / *tol* )
    (or *tol* (setq *tol* 1e-6))
    (if l (cons (car l) (unique (vl-remove-if '(lambda ( x ) (equal x (car l) *tol*)) (cdr l)))))
  )

  (defun _vl-position ( e l *z* / *tol* ) ;; *z* must be specified as nil ;;
    (or *tol* (setq *tol* 1e-6))
    (if (null *z*)
      (setq *z* 0)
    )
    (if (not (equal e (car l) *tol*))
      (progn
        (setq *z* (1+ *z*))
        (if (cdr l)
          (_vl-position e (cdr l) *z*)
          (setq *z* nil)
        )
      )
      *z*
    )
  )

  (defun unit ( v )
    (mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)
  )

  (defun acos ( x )
    (cond
      ( (equal x 1.0 1e-8)
        0.0
      )
      ( (equal x -1.0 1e-8)
        pi
      )
      ( (equal x 0.0 1e-8)
        (/ pi 2.0)
      )
      ( (equal x -0.0 1e-8)
        (* 3.0 (/ pi 2.0))
      )
      ( t
        (atan (/ (sqrt (- 1.0 (* x x))) x))
      )
    )
  )

  (defun angle3d ( p1 por p2 / vec1 vec2 dd ang )
    (setq vec1 (unit (mapcar '- p1 por))
          vec2 (unit (mapcar '- p2 por))
          dd (distance vec1 vec2)
          ang (acos (- 1.0 (/ (expt dd 2) 2.0)))
    )
    (if (minusp ang) (+ ang pi) ang)
  )

  (setq *tol* 1e-6)
  (setq osm (getvar 'osmode))
  (if (eq (getvar 'worlducs) 0)
    (progn
      (command "_.UCS" "_W")
      (setq f t)
    )
  )
  (prompt "\nSelect TRIANGULAR 3D FACES OF LINEAR LATTICE in 3D space to unfold them to the ground level 0.0...")
  (setq ss (ssget '((0 . "3DFACE"))))
  (if ss
    (progn
      (setvar 'osmode 512)
      (setq p (getpoint "\nPick edge from lattice contours you want me to align to X axis vector of WCS (important - first or last RIGHT BRANCH OF 3DFACE OF LINEAR LATTICE)..."))
      (setq es (nentselp p))
      (setq ip (getpoint "\nPick or specify insertion point in WCS plane : "))
      (while (not (equal (caddr ip) 0.0 *tol*))
        (prompt "\nPicked or specified insertion point not in WCS... Please retry specification of insertion point...")
        (setq ip (getpoint "\nPick or specify insertion point in WCS plane : "))
      )
      (setq espl (unique (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (_vl-position (car x) '(10 11 12 13) nil)) (entget (car es))))))
      (setq k -1)
      (while (not (equal (distance (nth (setq k (1+ k)) espl) (if (/= (1+ k) 3) (nth (1+ k) espl) (nth 0 espl))) (+ (distance (nth k espl) p) (distance p (if (/= (1+ k) 3) (nth (1+ k) espl) (nth 0 espl)))) *tol*)))
      (setq esdl (mapcar '(lambda ( a b ) (distance a b)) espl (append (cdr espl) (list (car espl)))))
      (setq esal (mapcar '(lambda ( c a b ) (if (and (not (equal c a *tol*)) (not (equal a b *tol*))) (angle3d c a b) 0.0)) (append (list (last espl)) (reverse (cdr (reverse espl)))) espl (append (cdr espl) (list (car espl)))))
      (setq 3dfpl (mapcar '(lambda ( x ) (unique (mapcar 'cdr (vl-remove-if-not '(lambda ( y ) (_vl-position (car y) '(10 11 12 13) nil)) (entget x))))) (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
      (setq 3dfplr (vl-remove espl 3dfpl))
      (setq 3dfdlr (mapcar '(lambda ( x ) (mapcar '(lambda ( a b ) (distance a b)) x (append (cdr x) (list (car x))))) 3dfplr))
      (setq 3dfalr (mapcar '(lambda ( x ) (mapcar '(lambda ( c a b ) (if (and (not (equal c a *tol*)) (not (equal a b *tol*))) (angle3d c a b) 0.0)) (append (list (last x)) (reverse (cdr (reverse x)))) x (append (cdr x) (list (car x))))) 3dfplr))
      (setq tmp esdl)
      (setq tmp3dfdlr 3dfdlr)
      (while (car tmp3dfdlr)
        (foreach tmpdl tmp3dfdlr
          (if (and (vl-some '(lambda ( x ) (_vl-position x (vl-remove-if '(lambda ( y ) (equal y 0.0 *tol*)) tmp) nil)) (vl-remove-if '(lambda ( y ) (equal y 0.0 *tol*)) tmpdl)) (not (_vl-position (_vl-position tmpdl 3dfdlr nil) nl nil)))
            (setq n (_vl-position tmpdl 3dfdlr nil) nl (cons n nl) tmp3dfdlr (vl-remove tmpdl tmp3dfdlr) tmp tmpdl)
          )
        )
      )
      (setq nl (reverse nl))
      (setq ptdptl1 (mapcar '(lambda ( p1 d p2 ) (list p1 d p2)) espl esdl (append (cdr espl) (list (car espl)))))
      (setq d1 (commonel esdl (nth (car nl) 3dfdlr)))
      (setq p1dp2l1 (car (vl-member-if '(lambda ( x ) (equal (cadr x) d1 *tol*)) ptdptl1)))
      (setq p1 (car p1dp2l1) p2 (caddr p1dp2l1) p3s (car (vl-remove p1 (vl-remove p2 espl))))
      (setq kk k kkk k)
      (setq esplp (list ip (setq ip (polar ip (setq an 0.0) (nth k esdl))) (setq ip (polar ip (setq an (+ an (- pi (nth (if (= (setq k (1+ k)) 3) 0 k) esal)))) (nth k esdl)))))
      (setq 3dfplp (cons esplp 3dfplp))
      (setq esdl (list (nth kk esdl) (nth (if (= (setq kk (1+ kk)) 3) 0 kk) esdl) (nth (if (= (setq kk (1+ kk)) 3) 0 kk) esdl)))
      (setq ptdptl1p (mapcar '(lambda ( p1 d p2 ) (list p1 d p2)) esplp esdl (append (cdr esplp) (list (car esplp)))))
      (setq ptdptll (mapcar '(lambda ( x y ) (mapcar '(lambda ( p1 d p2 ) (list p1 d p2)) x y (append (cdr x) (list (car x))))) 3dfplr 3dfdlr))
      (foreach n nl
        (setq n3dfpl (nth n 3dfplr) n3dfdl (nth n 3dfdlr) n3dfal (nth n 3dfalr))
        (setq ptdptl (mapcar '(lambda ( p1 d p2 ) (list p1 d p2)) n3dfpl n3dfdl (append (cdr n3dfpl) (list (car n3dfpl)))))
        (setq d (commonel (if (= n (car nl)) esdl (nth (nth (1- (_vl-position n nl nil)) nl) 3dfdlr)) n3dfdl))
        (setq p1dp2l (car (vl-member-if '(lambda ( x ) (equal (cadr x) d *tol*)) ptdptl)))
        (setq p1 (car p1dp2l) p2 (caddr p1dp2l) p3 (car (vl-remove p1 (vl-remove p2 n3dfpl))))
        (if (= n (car nl))
          (progn
            (setq p1 (car (vl-remove p3s (vl-remove (nth kkk esdl) (car (vl-member-if '(lambda ( x ) (equal (cadr x) (nth kkk esdl) *tol*)) ptdptl1))))))
            (setq p2 (car (vl-remove p1 (vl-remove d p1dp2l1))))
          )
        )
        (setq r1 (cadar (vl-member-if '(lambda ( x ) (or (equal (list (car x) (caddr x)) (list p1 p3) *tol*) (equal (list (car x) (caddr x)) (list p3 p1) *tol*))) ptdptl)))
        (setq r2 (cadar (vl-member-if '(lambda ( x ) (or (equal (list (car x) (caddr x)) (list p2 p3) *tol*) (equal (list (car x) (caddr x)) (list p3 p2) *tol*))) ptdptl)))
        (setq p1dl (unique (mapcar 'cadr (vl-remove-if-not '(lambda ( x ) (or (equal (car x) p1 *tol*) (equal (caddr x) p1 *tol*))) (apply 'append ptdptll)))))
        (if (= n (car nl)) (setq ptdptlp ptdptl1p))
        (setq p1dp2lp (car (vl-member-if '(lambda ( x ) (equal (cadr x) d *tol*)) ptdptlp)))
        (setq p1p (car p1dp2lp) p2p (caddr p1dp2lp))
        (if (= n (car nl))
          (progn
            (setq p1p (car (vl-remove ipp (vl-remove (nth kkk esdl) (car (vl-member-if '(lambda ( x ) (equal (cadr x) (nth kkk esdl) *tol*)) ptdptlp))))))
            (setq p2p (car (vl-remove p1p (vl-remove d p1dp2lp))))
          )
        )
        (if ptdptlpp
          (progn
            (setq p1pdl (unique (mapcar 'cadr (vl-remove-if-not '(lambda ( x ) (or (equal (car x) p1p *tol*) (equal (caddr x) p1p *tol*))) (apply 'append ptdptlpp)))))
            (foreach d p1dl
              (setq p1pdl (vl-remove-if '(lambda ( x ) (equal x d *tol*)) p1pdl))
            )
            (if p1pdl
              (mapcar 'set (list 'p1p 'p2p) (list p2p p1p))
            )
          )
        )
        (setq p3l (LM:int-ci-ci p1p r1 p2p r2))
        (if (not (LM:Clockwise-p (car (vl-remove p1p (vl-remove p2p (vl-remove-if-not 'listp (apply 'append ptdptlp))))) p1p p2p)) (setq p3p (car p3l)) (setq p3p (cadr p3l)))
        (setq n3dfplp (list p1p p2p p3p))
        (setq ptdptlp (list (list p2p (distance p1p p2p) p1p) (list p3p (distance p2p p3p) p2p) (list p1p (distance p3p p1p) p3p)))
        (setq ptdptlpp (cons ptdptlp ptdptlpp))
        (setq 3dfplp (cons n3dfplp 3dfplp))
      )
      (foreach 3df 3dfplp
        (entmake (list '(0 . "3DFACE") (cons 10 (car 3df)) (cons 11 (car 3df)) (cons 12 (cadr 3df)) (cons 13 (caddr 3df))))
      )
    )
    (prompt "\nEmpty sel.set... Retry routine again with some 3DFACE entities selected...")
  )
  (*error* nil)
)

[marko_ribar]

Previously posted lisp had some lacks... Hope that now it's all fine... Still there are some restrictions - look into previous post and see my posted DWG...

(defun c:xxx ( / *error* LM:int-ci-ci LM:Clockwise-p commonel unique _vl-position unit acos angle3d *tol* osm f ss p es ip espl esdl esal 3dfpl 3dfplr 3dfdl 3dfdlr 3dfal 3dfalr tmp tmp3dfdlr n nl ipp ptdptl1 d1 p1dp2l1 p1 p2 p3 ptdptl1p ptdptll p1dl r1 r2 esplp 3dfplp p1p p2p p3l p3p n3dfplp ptdptlp ptdptlpp 3dfplp n3dfpl n3dfdl n3dfal ptdptl d p1dp2l p1dp2lp p1pdl )

  (defun *error* ( m )
    (if osm (setvar 'osmode osm))
    (if f (command "_.UCS" "_P"))
    (if m (prompt m))
    (princ)
  )

  ;; 2-Circle Intersection (trans version)  -  Lee Mac
  ;; Returns the point(s) of intersection between two circles
  ;; with centres c1,c2 and radii r1,r2

  (defun LM:int-ci-ci ( c1 r1 c2 r2 / *n* *d1* *x* *z* )
    (if
      (and
        (< (setq *d1* (distance c1 c2)) (+ r1 r2))
        (< (abs (- r1 r2)) *d1*)
      )
      (progn
        (setq *n* (mapcar '- c2 c1))
        (setq c1 (trans c1 0 *n*))
        (setq *z* (/ (- (+ (* r1 r1) (* *d1* *d1*)) (* r2 r2)) (+ *d1* *d1*)))
        (if (equal *z* r1 1e-8)
          (list (trans (list (car c1) (cadr c1) (+ (caddr c1) *z*)) *n* 0))
          (progn
            (setq *x* (sqrt (- (* r1 r1) (* *z* *z*))))
            (list
              (trans (list (- (car c1) *x*) (cadr c1) (+ (caddr c1) *z*)) *n* 0)
              (trans (list (+ (car c1) *x*) (cadr c1) (+ (caddr c1) *z*)) *n* 0)
            )
          )
        )
      )
    )
  )

  ;; Clockwise-p  -  Lee Mac
  ;; Returns T if p1,p2,p3 are clockwise oriented or collinear

  (defun LM:Clockwise-p ( p1 p2 p3 )
    (< (-  (* (- (car  p2) (car  p1)) (- (cadr p3) (cadr p1)))
           (* (- (cadr p2) (cadr p1)) (- (car  p3) (car  p1)))
       )
       1e-8
    )
  )

  (defun commonel ( l1 l2 / *tol* r )
    (or *tol* (setq *tol* 1e-6))
    (foreach e l1
      (if (vl-member-if '(lambda ( x ) (equal e x *tol*)) l2)
        (setq r e)
      )
    )
    r
  )

  (defun unique ( l / *tol* )
    (or *tol* (setq *tol* 1e-6))
    (if l (cons (car l) (unique (vl-remove-if '(lambda ( x ) (equal x (car l) *tol*)) (cdr l)))))
  )

  (defun _vl-position ( e l *z* / *tol* ) ;; *z* must be specified as nil ;;
    (or *tol* (setq *tol* 1e-6))
    (if (null *z*)
      (setq *z* 0)
    )
    (if (not (equal e (car l) *tol*))
      (progn
        (setq *z* (1+ *z*))
        (if (cdr l)
          (_vl-position e (cdr l) *z*)
          (setq *z* nil)
        )
      )
      *z*
    )
  )

  (defun unit ( v )
    (mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)
  )

  (defun acos ( x )
    (cond
      ( (equal x 1.0 1e-8)
        0.0
      )
      ( (equal x -1.0 1e-8)
        pi
      )
      ( (equal x 0.0 1e-8)
        (/ pi 2.0)
      )
      ( (equal x -0.0 1e-8)
        (* 3.0 (/ pi 2.0))
      )
      ( t
        (atan (/ (sqrt (- 1.0 (* x x))) x))
      )
    )
  )

  (defun angle3d ( p1 por p2 / vec1 vec2 dd ang )
    (setq vec1 (unit (mapcar '- p1 por))
          vec2 (unit (mapcar '- p2 por))
          dd (distance vec1 vec2)
          ang (acos (- 1.0 (/ (expt dd 2) 2.0)))
    )
    (if (minusp ang) (+ ang pi) ang)
  )

  (setq *tol* 1e-6)
  (setq osm (getvar 'osmode))
  (if (eq (getvar 'worlducs) 0)
    (progn
      (command "_.UCS" "_W")
      (setq f t)
    )
  )
  (prompt "\nSelect TRIANGULAR 3D FACES OF LINEAR LATTICE in 3D space to unfold them to the ground level 0.0...")
  (setq ss (ssget '((0 . "3DFACE"))))
  (if ss
    (progn
      (setvar 'osmode 512)
      (setq p (getpoint "\nPick edge from lattice contours you want me to align to X axis vector of WCS (important - first or last 3DFACE OF LINEAR LATTICE)..."))
      (setq es (nentselp p))
      (setq ip (getpoint "\nPick or specify insertion point in WCS plane : "))
      (while (not (equal (caddr ip) 0.0 *tol*))
        (prompt "\nPicked or specified insertion point not in WCS... Please retry specification of insertion point...")
        (setq ip (getpoint "\nPick or specify insertion point in WCS plane : "))
      )
      (setq espl (unique (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (_vl-position (car x) '(10 11 12 13) nil)) (entget (car es))))))
      (setq esdl (mapcar '(lambda ( a b ) (distance a b)) espl (append (cdr espl) (list (car espl)))))
      (setq esal (mapcar '(lambda ( c a b ) (if (and (not (equal c a *tol*)) (not (equal a b *tol*))) (angle3d c a b) 0.0)) (append (list (last espl)) (reverse (cdr (reverse espl)))) espl (append (cdr espl) (list (car espl)))))
      (setq 3dfpl (mapcar '(lambda ( x ) (unique (mapcar 'cdr (vl-remove-if-not '(lambda ( y ) (_vl-position (car y) '(10 11 12 13) nil)) (entget x))))) (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
      (setq 3dfplr (vl-remove espl 3dfpl))
      (setq 3dfdl (mapcar '(lambda ( x ) (mapcar '(lambda ( a b ) (distance a b)) x (append (cdr x) (list (car x))))) 3dfpl))
      (setq 3dfdlr (mapcar '(lambda ( x ) (mapcar '(lambda ( a b ) (distance a b)) x (append (cdr x) (list (car x))))) 3dfplr))
      (setq 3dfal (mapcar '(lambda ( x ) (mapcar '(lambda ( c a b ) (if (and (not (equal c a *tol*)) (not (equal a b *tol*))) (angle3d c a b) 0.0)) (append (list (last x)) (reverse (cdr (reverse x)))) x (append (cdr x) (list (car x))))) 3dfpl))
      (setq 3dfalr (mapcar '(lambda ( x ) (mapcar '(lambda ( c a b ) (if (and (not (equal c a *tol*)) (not (equal a b *tol*))) (angle3d c a b) 0.0)) (append (list (last x)) (reverse (cdr (reverse x)))) x (append (cdr x) (list (car x))))) 3dfplr))
      (setq tmp esdl)
      (setq tmp3dfdlr 3dfdlr)
      (while (car tmp3dfdlr)
        (foreach tmpdl tmp3dfdlr
          (if (and (vl-some '(lambda ( x ) (_vl-position x (vl-remove-if '(lambda ( y ) (equal y 0.0 *tol*)) tmp) nil)) (vl-remove-if '(lambda ( y ) (equal y 0.0 *tol*)) tmpdl)) (not (_vl-position (_vl-position tmpdl 3dfdlr nil) nl nil)))
            (setq n (_vl-position tmpdl 3dfdlr nil) nl (cons n nl) tmp3dfdlr (vl-remove tmpdl tmp3dfdlr) tmp tmpdl)
          )
        )
      )
      (setq nl (reverse nl))
      (setq ipp ip)
      (setq ptdptl1 (mapcar '(lambda ( p1 d p2 ) (list p1 d p2)) espl esdl (append (cdr espl) (list (car espl)))))
      (setq d1 (commonel esdl (nth (car nl) 3dfdlr)))
      (setq p1dp2l1 (car (vl-member-if '(lambda ( x ) (equal (cadr x) d1 *tol*)) ptdptl1)))
      (setq p1 (car p1dp2l1) p2 (caddr p1dp2l1) p3 (car (vl-remove p1 (vl-remove p2 espl))))
      (setq ptdptl1p (mapcar '(lambda ( p1 d p2 ) (list p1 d p2)) esplp esdl (append (cdr esplp) (list (car esplp)))))
      (setq ptdptll (mapcar '(lambda ( x y ) (mapcar '(lambda ( p1 d p2 ) (list p1 d p2)) x y (append (cdr x) (list (car x))))) 3dfpl 3dfdl))
      (setq p1dl (unique (mapcar 'cadr (vl-remove-if-not '(lambda ( x ) (or (equal (car x) p1 *tol*) (equal (caddr x) p1 *tol*))) (apply 'append ptdptll)))))
      (setq r1 (cadar (vl-member-if '(lambda ( x ) (or (equal (list (car x) (caddr x)) (list p1 p3) *tol*) (equal (list (car x) (caddr x)) (list p3 p1) *tol*))) ptdptl1)))
      (setq r2 (cadar (vl-member-if '(lambda ( x ) (or (equal (list (car x) (caddr x)) (list p2 p3) *tol*) (equal (list (car x) (caddr x)) (list p3 p2) *tol*))) ptdptl1)))
      (if (not (vl-some '(lambda ( x ) (equal x r1 *tol*)) p1dl))
        (mapcar 'set (list 'p1 'p2) (list p2 p1))
      )
      (setq esal (list (angle3d p2 p3 p1) (angle3d p3 p1 p2) (angle3d p1 p2 p3)))
      (setq esdl (list (distance p3 p1) d1 (distance p2 p3)))
      (setq esplp (list ip (setq ip (polar ip 0.0 (distance p3 p1))) (setq ip (polar ip (- pi (nth 1 esal)) d1))))
      (setq 3dfplp (cons esplp 3dfplp))
      (setq p1p (cadr esplp) p2p (caddr esplp))
      (setq p3 (car (vl-remove p1 (vl-remove p2 (nth (car nl) 3dfplr)))))
      (setq ptdptl (mapcar '(lambda ( p1 d p2 ) (list p1 d p2)) (nth (car nl) 3dfplr) (nth (car nl) 3dfdlr) (append (cdr (nth (car nl) 3dfplr)) (list (car (nth (car nl) 3dfplr))))))
      (setq d (commonel esdl (nth (car nl) 3dfdlr)))
      (setq p1dp2l (car (vl-member-if '(lambda ( x ) (equal (cadr x) d *tol*)) ptdptl)))
      (setq r1 (cadar (vl-member-if '(lambda ( x ) (or (equal (list (car x) (caddr x)) (list p1 p3) *tol*) (equal (list (car x) (caddr x)) (list p3 p1) *tol*))) ptdptl)))
      (setq r2 (cadar (vl-member-if '(lambda ( x ) (or (equal (list (car x) (caddr x)) (list p2 p3) *tol*) (equal (list (car x) (caddr x)) (list p3 p2) *tol*))) ptdptl)))
      (setq p3l (LM:int-ci-ci p1p r1 p2p r2))
      (if (not (LM:Clockwise-p ipp p1p p2p)) (setq p3p (car p3l)) (setq p3p (cadr p3l)))
      (setq n3dfplp (list p1p p2p p3p))
      (setq ptdptlp (list (list p3p (distance p3p p1p) p1p) (list p1p (distance p1p p2p) p2p) (list p2p (distance p2p p3p) p3p)))
      (setq ptdptlpp (cons ptdptlp ptdptlpp))
      (setq 3dfplp (cons n3dfplp 3dfplp))
      (foreach n (vl-remove (car nl) nl)
        (setq n3dfpl (nth n 3dfplr) n3dfdl (nth n 3dfdlr) n3dfal (nth n 3dfalr))
        (setq ptdptl (mapcar '(lambda ( p1 d p2 ) (list p1 d p2)) n3dfpl n3dfdl (append (cdr n3dfpl) (list (car n3dfpl)))))
        (setq d (commonel (nth (nth (1- (_vl-position n nl nil)) nl) 3dfdlr) n3dfdl))
        (setq p1dp2l (car (vl-member-if '(lambda ( x ) (equal (cadr x) d *tol*)) ptdptl)))
        (setq p1 (car p1dp2l) p2 (caddr p1dp2l) p3 (car (vl-remove p1 (vl-remove p2 n3dfpl))))
        (setq r1 (cadar (vl-member-if '(lambda ( x ) (or (equal (list (car x) (caddr x)) (list p1 p3) *tol*) (equal (list (car x) (caddr x)) (list p3 p1) *tol*))) ptdptl)))
        (setq r2 (cadar (vl-member-if '(lambda ( x ) (or (equal (list (car x) (caddr x)) (list p2 p3) *tol*) (equal (list (car x) (caddr x)) (list p3 p2) *tol*))) ptdptl)))
        (setq p1dl (unique (mapcar 'cadr (vl-remove-if-not '(lambda ( x ) (or (equal (car x) p1 *tol*) (equal (caddr x) p1 *tol*))) (apply 'append ptdptll)))))
        (setq p1dp2lp (car (vl-member-if '(lambda ( x ) (equal (cadr x) d *tol*)) ptdptlp)))
        (setq p1p (car p1dp2lp) p2p (caddr p1dp2lp))
        (if ptdptlpp
          (progn
            (setq p1pdl (unique (mapcar 'cadr (vl-remove-if-not '(lambda ( x ) (or (equal (car x) p1p *tol*) (equal (caddr x) p1p *tol*))) (apply 'append ptdptlpp)))))
            (foreach d p1dl
              (setq p1pdl (vl-remove-if '(lambda ( x ) (equal x d *tol*)) p1pdl))
            )
            (if p1pdl
              (mapcar 'set (list 'p1p 'p2p) (list p2p p1p))
            )
          )
        )
        (setq p3l (LM:int-ci-ci p1p r1 p2p r2))
        (if (not (LM:Clockwise-p (car (vl-remove p1p (vl-remove p2p (vl-remove-if-not 'listp (apply 'append ptdptlp))))) p1p p2p)) (setq p3p (car p3l)) (setq p3p (cadr p3l)))
        (setq n3dfplp (list p1p p2p p3p))
        (setq ptdptlp (list (list p3p (distance p3p p1p) p1p) (list p1p (distance p1p p2p) p2p) (list p2p (distance p2p p3p) p3p)))
        (setq ptdptlpp (cons ptdptlp ptdptlpp))
        (setq 3dfplp (cons n3dfplp 3dfplp))
      )
      (foreach 3df 3dfplp
        (entmake (list '(0 . "3DFACE") (cons 10 (car 3df)) (cons 11 (car 3df)) (cons 12 (cadr 3df)) (cons 13 (caddr 3df))))
      )
    )
    (prompt "\nEmpty sel.set... Retry routine again with some 3DFACE entities selected...")
  )
  (*error* nil)
)

Regards, M.R.

[carlos_m_gil_p]

Hi How Are you.

Thank you very much for your help.

About lisp.

Already ran.
But still it has details.

I think it is time to check the length, not to have equal lengths.

It will always have branches.

And sometimes they do not run the lisp.

I also want you to see this lisp.

Author: nolo (Hispacad)

Also I am helping me with this program.

But sometimes gives errors, you can try it in the same dwg.

Excuse my English, I only speak Spanish.

Greetings and thank you very much again.

[marko_ribar]

Wow... I can't follow your lisp - it seems that more skilled programmer wrote that lisp well... Still I've managed to make my version final and appropriate for any situation with limitations explained in DWG I posted before... So not big deal, I'll post my version if you don't mind, and yes I am fine thanks...

(defun c:xxx ( / *error* LM:int-ci-ci LM:Clockwise-p commonel unique _vl-position unit acos angle3d *tol* osm f ss p es ip espl esdl esal 3dfpl 3dfplr 3dfdl 3dfdlr 3dfal 3dfalr tmp tmp3dfdlr n nl ipp ptdptl1 d1 p1dp2l1 p1 p2 p3 ptdptll p1dl r1 r2 esplp 3dfplp p1p p2p p3l p3p n3dfplp ptdptlp ptdptlpp 3dfplp n3dfpl n3dfdl n3dfal ptdptl d p1dp2l p1dp2lp p1pdl )

  (defun *error* ( m )
    (if osm (setvar 'osmode osm))
    (if f (command "_.UCS" "_P"))
    (if m (prompt m))
    (princ)
  )

  ;; 2-Circle Intersection (trans version)  -  Lee Mac
  ;; Returns the point(s) of intersection between two circles
  ;; with centres c1,c2 and radii r1,r2

  (defun LM:int-ci-ci ( c1 r1 c2 r2 / *n* *d1* *x* *z* )
    (if
      (and
        (< (setq *d1* (distance c1 c2)) (+ r1 r2))
        (< (abs (- r1 r2)) *d1*)
      )
      (progn
        (setq *n* (mapcar '- c2 c1))
        (setq c1 (trans c1 0 *n*))
        (setq *z* (/ (- (+ (* r1 r1) (* *d1* *d1*)) (* r2 r2)) (+ *d1* *d1*)))
        (if (equal *z* r1 1e-8)
          (list (trans (list (car c1) (cadr c1) (+ (caddr c1) *z*)) *n* 0))
          (progn
            (setq *x* (sqrt (- (* r1 r1) (* *z* *z*))))
            (list
              (trans (list (- (car c1) *x*) (cadr c1) (+ (caddr c1) *z*)) *n* 0)
              (trans (list (+ (car c1) *x*) (cadr c1) (+ (caddr c1) *z*)) *n* 0)
            )
          )
        )
      )
    )
  )

  ;; Clockwise-p  -  Lee Mac
  ;; Returns T if p1,p2,p3 are clockwise oriented or collinear

  (defun LM:Clockwise-p ( p1 p2 p3 )
    (< (-  (* (- (car  p2) (car  p1)) (- (cadr p3) (cadr p1)))
           (* (- (cadr p2) (cadr p1)) (- (car  p3) (car  p1)))
       )
       1e-8
    )
  )

  (defun commonel ( l1 l2 / *tol* r )
    (or *tol* (setq *tol* 1e-6))
    (foreach e l1
      (if (vl-member-if '(lambda ( x ) (equal e x *tol*)) l2)
        (setq r e)
      )
    )
    r
  )

  (defun unique ( l / *tol* )
    (or *tol* (setq *tol* 1e-6))
    (if l (cons (car l) (unique (vl-remove-if '(lambda ( x ) (equal x (car l) *tol*)) (cdr l)))))
  )

  (defun _vl-position ( e l *z* / *tol* ) ;; *z* must be specified as nil ;;
    (or *tol* (setq *tol* 1e-6))
    (if (null *z*)
      (setq *z* 0)
    )
    (if (not (equal e (car l) *tol*))
      (progn
        (setq *z* (1+ *z*))
        (if (cdr l)
          (_vl-position e (cdr l) *z*)
          (setq *z* nil)
        )
      )
      *z*
    )
  )

  (defun unit ( v )
    (mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)
  )

  (defun acos ( x )
    (cond
      ( (equal x 1.0 1e-8)
        0.0
      )
      ( (equal x -1.0 1e-8)
        pi
      )
      ( (equal x 0.0 1e-8)
        (/ pi 2.0)
      )
      ( (equal x -0.0 1e-8)
        (* 3.0 (/ pi 2.0))
      )
      ( t
        (atan (/ (sqrt (- 1.0 (* x x))) x))
      )
    )
  )

  (defun angle3d ( p1 por p2 / vec1 vec2 dd ang )
    (setq vec1 (unit (mapcar '- p1 por))
          vec2 (unit (mapcar '- p2 por))
          dd (distance vec1 vec2)
          ang (acos (- 1.0 (/ (expt dd 2) 2.0)))
    )
    (if (minusp ang) (+ ang pi) ang)
  )

  (setq *tol* 1e-6)
  (setq osm (getvar 'osmode))
  (if (eq (getvar 'worlducs) 0)
    (progn
      (command "_.UCS" "_W")
      (setq f t)
    )
  )
  (prompt "\nSelect TRIANGULAR 3D FACES OF LINEAR LATTICE in 3D space to unfold them to the ground level 0.0...")
  (setq ss (ssget '((0 . "3DFACE"))))
  (if ss
    (progn
      (setvar 'osmode 512)
      (setq p (getpoint "\nPick edge from lattice contours you want me to align to X axis vector of WCS (important - first or last 3DFACE OF LINEAR LATTICE)..."))
      (setq es (nentselp p))
      (setq ip (getpoint "\nPick or specify insertion point in WCS plane : "))
      (while (not (equal (caddr ip) 0.0 *tol*))
        (prompt "\nPicked or specified insertion point not in WCS... Please retry specification of insertion point...")
        (setq ip (getpoint "\nPick or specify insertion point in WCS plane : "))
      )
      (setq espl (unique (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (_vl-position (car x) '(10 11 12 13) nil)) (entget (car es))))))
      (setq esdl (mapcar '(lambda ( a b ) (distance a b)) espl (append (cdr espl) (list (car espl)))))
      (setq esal (mapcar '(lambda ( c a b ) (if (and (not (equal c a *tol*)) (not (equal a b *tol*))) (angle3d c a b) 0.0)) (append (list (last espl)) (reverse (cdr (reverse espl)))) espl (append (cdr espl) (list (car espl)))))
      (setq 3dfpl (mapcar '(lambda ( x ) (unique (mapcar 'cdr (vl-remove-if-not '(lambda ( y ) (_vl-position (car y) '(10 11 12 13) nil)) (entget x))))) (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
      (setq 3dfplr (vl-remove espl 3dfpl))
      (setq 3dfdl (mapcar '(lambda ( x ) (mapcar '(lambda ( a b ) (distance a b)) x (append (cdr x) (list (car x))))) 3dfpl))
      (setq 3dfdlr (mapcar '(lambda ( x ) (mapcar '(lambda ( a b ) (distance a b)) x (append (cdr x) (list (car x))))) 3dfplr))
      (setq 3dfal (mapcar '(lambda ( x ) (mapcar '(lambda ( c a b ) (if (and (not (equal c a *tol*)) (not (equal a b *tol*))) (angle3d c a b) 0.0)) (append (list (last x)) (reverse (cdr (reverse x)))) x (append (cdr x) (list (car x))))) 3dfpl))
      (setq 3dfalr (mapcar '(lambda ( x ) (mapcar '(lambda ( c a b ) (if (and (not (equal c a *tol*)) (not (equal a b *tol*))) (angle3d c a b) 0.0)) (append (list (last x)) (reverse (cdr (reverse x)))) x (append (cdr x) (list (car x))))) 3dfplr))
      (setq tmp esdl)
      (setq tmp3dfdlr 3dfdlr)
      (while (car tmp3dfdlr)
        (foreach tmpdl tmp3dfdlr
          (if (and (vl-some '(lambda ( x ) (_vl-position x (vl-remove-if '(lambda ( y ) (equal y 0.0 *tol*)) tmp) nil)) (vl-remove-if '(lambda ( y ) (equal y 0.0 *tol*)) tmpdl)) (not (_vl-position (_vl-position tmpdl 3dfdlr nil) nl nil)))
            (setq n (_vl-position tmpdl 3dfdlr nil) nl (cons n nl) tmp3dfdlr (vl-remove tmpdl tmp3dfdlr) tmp tmpdl)
          )
        )
      )
      (setq nl (reverse nl))
      (setq ipp ip)
      (setq ptdptl1 (mapcar '(lambda ( p1 d p2 ) (list p1 d p2)) espl esdl (append (cdr espl) (list (car espl)))))
      (setq d1 (commonel esdl (nth (car nl) 3dfdlr)))
      (setq p1dp2l1 (car (vl-member-if '(lambda ( x ) (equal (cadr x) d1 *tol*)) ptdptl1)))
      (setq p1 (car p1dp2l1) p2 (caddr p1dp2l1) p3 (car (vl-remove p1 (vl-remove p2 espl))))
      (setq ptdptll (mapcar '(lambda ( x y ) (mapcar '(lambda ( p1 d p2 ) (list p1 d p2)) x y (append (cdr x) (list (car x))))) 3dfpl 3dfdl))
      (setq p1dl (unique (mapcar 'cadr (vl-remove-if-not '(lambda ( x ) (or (equal (car x) p1 *tol*) (equal (caddr x) p1 *tol*))) (apply 'append ptdptll)))))
      (setq r1 (cadar (vl-member-if '(lambda ( x ) (or (equal (list (car x) (caddr x)) (list p1 p3) *tol*) (equal (list (car x) (caddr x)) (list p3 p1) *tol*))) ptdptl1)))
      (setq r2 (cadar (vl-member-if '(lambda ( x ) (or (equal (list (car x) (caddr x)) (list p2 p3) *tol*) (equal (list (car x) (caddr x)) (list p3 p2) *tol*))) ptdptl1)))
      (if (not (vl-some '(lambda ( x ) (equal x r1 *tol*)) p1dl))
        (mapcar 'set (list 'p1 'p2) (list p2 p1))
      )
      (if (LM:Clockwise-p p3 p2 p1)
        (progn
          (mapcar 'set (list 'p1 'p2) (list p2 p1))
          (mapcar 'set (list 'r1 'r2) (list r2 r1))
        )
      )
      (setq esal (list (angle3d p2 p3 p1) (angle3d p3 p1 p2) (angle3d p1 p2 p3)))
      (setq esdl (list (distance p3 p1) d1 (distance p2 p3)))
      (setq esplp (list ip (setq ip (polar ip 0.0 (distance p3 p1))) (setq ip (polar ip (- pi (nth 1 esal)) d1))))
      (setq 3dfplp (cons esplp 3dfplp))
      (setq p1p (cadr esplp) p2p (caddr esplp))
      (setq p3 (car (vl-remove p1 (vl-remove p2 (nth (car nl) 3dfplr)))))
      (setq ptdptl (mapcar '(lambda ( p1 d p2 ) (list p1 d p2)) (nth (car nl) 3dfplr) (nth (car nl) 3dfdlr) (append (cdr (nth (car nl) 3dfplr)) (list (car (nth (car nl) 3dfplr))))))
      (setq d (commonel esdl (nth (car nl) 3dfdlr)))
      (setq p1dp2l (car (vl-member-if '(lambda ( x ) (equal (cadr x) d *tol*)) ptdptl)))
      (setq r1 (cadar (vl-member-if '(lambda ( x ) (or (equal (list (car x) (caddr x)) (list p1 p3) *tol*) (equal (list (car x) (caddr x)) (list p3 p1) *tol*))) ptdptl)))
      (setq r2 (cadar (vl-member-if '(lambda ( x ) (or (equal (list (car x) (caddr x)) (list p2 p3) *tol*) (equal (list (car x) (caddr x)) (list p3 p2) *tol*))) ptdptl)))
      (setq p3l (LM:int-ci-ci p1p r1 p2p r2))
      (if (not (LM:Clockwise-p (car p3l) p2p p1p)) (setq p3p (car p3l)) (setq p3p (cadr p3l)))
      (setq n3dfplp (list p3p p2p p1p))
      (setq ptdptlp (list (list p3p (distance p3p p2p) p2p) (list p2p (distance p2p p1p) p1p) (list p1p (distance p1p p3p) p3p)))
      (setq ptdptlpp (cons ptdptlp ptdptlpp))
      (setq 3dfplp (cons n3dfplp 3dfplp))
      (foreach n (vl-remove (car nl) nl)
        (setq n3dfpl (nth n 3dfplr) n3dfdl (nth n 3dfdlr) n3dfal (nth n 3dfalr))
        (setq ptdptl (mapcar '(lambda ( p1 d p2 ) (list p1 d p2)) n3dfpl n3dfdl (append (cdr n3dfpl) (list (car n3dfpl)))))
        (setq d (commonel (nth (nth (1- (_vl-position n nl nil)) nl) 3dfdlr) n3dfdl))
        (setq p1dp2l (car (vl-member-if '(lambda ( x ) (equal (cadr x) d *tol*)) ptdptl)))
        (setq p1 (car p1dp2l) p2 (caddr p1dp2l) p3 (car (vl-remove p1 (vl-remove p2 n3dfpl))))
        (setq r1 (cadar (vl-member-if '(lambda ( x ) (or (equal (list (car x) (caddr x)) (list p1 p3) *tol*) (equal (list (car x) (caddr x)) (list p3 p1) *tol*))) ptdptl)))
        (setq r2 (cadar (vl-member-if '(lambda ( x ) (or (equal (list (car x) (caddr x)) (list p2 p3) *tol*) (equal (list (car x) (caddr x)) (list p3 p2) *tol*))) ptdptl)))
        (if (LM:Clockwise-p p3 p2 p1)
          (progn
            (mapcar 'set (list 'p1 'p2) (list p2 p1))
            (mapcar 'set (list 'r1 'r2) (list r2 r1))
          )
        )
        (setq p1dl (unique (mapcar 'cadr (vl-remove-if-not '(lambda ( x ) (or (equal (car x) p1 *tol*) (equal (caddr x) p1 *tol*))) (apply 'append ptdptll)))))
        (setq p1dp2lp (car (vl-member-if '(lambda ( x ) (equal (cadr x) d *tol*)) ptdptlp)))
        (setq p1p (car p1dp2lp) p2p (caddr p1dp2lp))
        (if ptdptlpp
          (progn
            (setq p1pdl (unique (mapcar 'cadr (vl-remove-if-not '(lambda ( x ) (or (equal (car x) p1p *tol*) (equal (caddr x) p1p *tol*))) (apply 'append ptdptlpp)))))
            (foreach d p1dl
              (setq p1pdl (vl-remove-if '(lambda ( x ) (equal x d *tol*)) p1pdl))
            )
            (if p1pdl
              (mapcar 'set (list 'p1p 'p2p) (list p2p p1p))
            )
          )
        )
        (setq p3l (LM:int-ci-ci p1p r1 p2p r2))
        (if (not (LM:Clockwise-p (caar 3dfplp) (cadar 3dfplp) (caddar 3dfplp)))
          (mapcar 'set (list 'p1p 'p2p) (list p2p p1p))
        )
        (if (not (LM:Clockwise-p (car p3l) p2p p1p)) (setq p3p (car p3l)) (setq p3p (cadr p3l)))
        (setq n3dfplp (list p3p p2p p1p))
        (setq ptdptlp (list (list p3p (distance p3p p2p) p2p) (list p2p (distance p2p p1p) p1p) (list p1p (distance p1p p3p) p3p)))
        (setq ptdptlpp (cons ptdptlp ptdptlpp))
        (setq 3dfplp (cons n3dfplp 3dfplp))
      )
      (foreach 3df 3dfplp
        (entmake (list '(0 . "3DFACE") (cons 10 (car 3df)) (cons 11 (car 3df)) (cons 12 (cadr 3df)) (cons 13 (caddr 3df))))
      )
    )
    (prompt "\nEmpty sel.set... Retry routine again with some 3DFACE entities selected...")
  )
  (*error* nil)
)

Regards, and when you already have lisp more appropriate this topic is solved with your reply post, so please mark it (I can't as I am not OP...)

HTH, M.R.

[marko_ribar]

I was wrong, I lied for equal distances - now that's fixed, but still remains issue with branches and vertical 3dfaces - verticals you can always bump on WCS plane - just rotate them along some WCS axis by 90 degree - then you'll have to align edge with other edges to form unique unfold lattice... So for now my version is pure linear... Again I say : If you're satisfied with current solution mark it as solved... Thanks, M.R.

(defun c:xxx ( / *error* LM:int-ci-ci LM:Clockwise-p commondst unique _vl-position unit acos angle3d *tol* osm f ss p es ip espl esdl esal 3dfpl 3dfplr 3dfdl 3dfdlr 3dfal 3dfalr tmp tmp3dfdlr tmp3dfdlrtmp n nl ipp ptdptl1 d1 p1dp2l1 p1 p2 p3 ptdptll p1dl r1 r2 esplp 3dfplp p1p p2p p3l p3p n3dfplp ptdptlp ptdptlpp 3dfplp n3dfpl n3dfdl n3dfal ptdptl d p1dp2l p1dp2lp p1pdl )

  (defun *error* ( m )
    (if osm (setvar 'osmode osm))
    (if f (command "_.UCS" "_P"))
    (if m (prompt m))
    (princ)
  )

  ;; 2-Circle Intersection (trans version)  -  Lee Mac
  ;; Returns the point(s) of intersection between two circles
  ;; with centres c1,c2 and radii r1,r2

  (defun LM:int-ci-ci ( c1 r1 c2 r2 / *n* *d1* *x* *z* )
    (if
      (and
        (< (setq *d1* (distance c1 c2)) (+ r1 r2))
        (< (abs (- r1 r2)) *d1*)
      )
      (progn
        (setq *n* (mapcar '- c2 c1))
        (setq c1 (trans c1 0 *n*))
        (setq *z* (/ (- (+ (* r1 r1) (* *d1* *d1*)) (* r2 r2)) (+ *d1* *d1*)))
        (if (equal *z* r1 1e-8)
          (list (trans (list (car c1) (cadr c1) (+ (caddr c1) *z*)) *n* 0))
          (progn
            (setq *x* (sqrt (- (* r1 r1) (* *z* *z*))))
            (list
              (trans (list (- (car c1) *x*) (cadr c1) (+ (caddr c1) *z*)) *n* 0)
              (trans (list (+ (car c1) *x*) (cadr c1) (+ (caddr c1) *z*)) *n* 0)
            )
          )
        )
      )
    )
  )

  ;; Clockwise-p  -  Lee Mac
  ;; Returns T if p1,p2,p3 are clockwise oriented or collinear

  (defun LM:Clockwise-p ( p1 p2 p3 )
    (< (-  (* (- (car  p2) (car  p1)) (- (cadr p3) (cadr p1)))
           (* (- (cadr p2) (cadr p1)) (- (car  p3) (car  p1)))
       )
       1e-8
    )
  )

  (defun commondst ( l1 l2 / *tol* r ) ;; l1 = ((p11 d1 p21) (p12 d2 p22) (p13 d3 p23)) ; l2 = ((p11 d1 p21) (p12 d2 p22) (p13 d3 p23))
    (or *tol* (setq *tol* 1e-6))
    (foreach e l1
      (if (vl-member-if '(lambda ( x ) (or (equal e x *tol*) (equal e (reverse x) *tol*))) l2)
        (setq r e)
      )
    )
    (cadr r)
  )

  (defun unique ( l / *tol* )
    (or *tol* (setq *tol* 1e-6))
    (if l (cons (car l) (unique (vl-remove-if '(lambda ( x ) (equal x (car l) *tol*)) (cdr l)))))
  )

  (defun _vl-position ( e l *z* / *tol* ) ;; *z* must be specified as nil ;;
    (or *tol* (setq *tol* 1e-6))
    (if (null *z*)
      (setq *z* 0)
    )
    (if (not (equal e (car l) *tol*))
      (progn
        (setq *z* (1+ *z*))
        (if (cdr l)
          (_vl-position e (cdr l) *z*)
          (setq *z* nil)
        )
      )
      *z*
    )
  )

  (defun unit ( v )
    (mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)
  )

  (defun acos ( x )
    (cond
      ( (equal x 1.0 1e-8)
        0.0
      )
      ( (equal x -1.0 1e-8)
        pi
      )
      ( (equal x 0.0 1e-8)
        (/ pi 2.0)
      )
      ( (equal x -0.0 1e-8)
        (* 3.0 (/ pi 2.0))
      )
      ( t
        (atan (/ (sqrt (- 1.0 (* x x))) x))
      )
    )
  )

  (defun angle3d ( p1 por p2 / vec1 vec2 dd ang )
    (setq vec1 (unit (mapcar '- p1 por))
          vec2 (unit (mapcar '- p2 por))
          dd (distance vec1 vec2)
          ang (acos (- 1.0 (/ (expt dd 2) 2.0)))
    )
    (if (minusp ang) (+ ang pi) ang)
  )

  (setq *tol* 1e-6)
  (setq osm (getvar 'osmode))
  (if (eq (getvar 'worlducs) 0)
    (progn
      (command "_.UCS" "_W")
      (setq f t)
    )
  )
  (prompt "\nSelect TRIANGULAR 3D FACES OF LINEAR LATTICE in 3D space to unfold them to the ground level 0.0...")
  (setq ss (ssget '((0 . "3DFACE"))))
  (if ss
    (progn
      (setvar 'osmode 512)
      (setq p (getpoint "\nPick edge from lattice contours you want me to align to X axis vector of WCS (important - first or last 3DFACE OF LINEAR LATTICE)..."))
      (setq es (nentselp p))
      (setq ip (getpoint "\nPick or specify insertion point in WCS plane : "))
      (while (not (equal (caddr ip) 0.0 *tol*))
        (prompt "\nPicked or specified insertion point not in WCS... Please retry specification of insertion point...")
        (setq ip (getpoint "\nPick or specify insertion point in WCS plane : "))
      )
      (setq espl (unique (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (_vl-position (car x) '(10 11 12 13) nil)) (entget (car es))))))
      (setq esdl (mapcar '(lambda ( a b ) (distance a b)) espl (append (cdr espl) (list (car espl)))))
      (setq esal (mapcar '(lambda ( c a b ) (if (and (not (equal c a *tol*)) (not (equal a b *tol*))) (angle3d c a b) 0.0)) (append (list (last espl)) (reverse (cdr (reverse espl)))) espl (append (cdr espl) (list (car espl)))))
      (setq 3dfpl (mapcar '(lambda ( x ) (unique (mapcar 'cdr (vl-remove-if-not '(lambda ( y ) (_vl-position (car y) '(10 11 12 13) nil)) (entget x))))) (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
      (setq 3dfplr (vl-remove espl 3dfpl))
      (setq 3dfdl (mapcar '(lambda ( x ) (mapcar '(lambda ( a b ) (distance a b)) x (append (cdr x) (list (car x))))) 3dfpl))
      (setq 3dfdlr (mapcar '(lambda ( x ) (mapcar '(lambda ( a b ) (distance a b)) x (append (cdr x) (list (car x))))) 3dfplr))
      (setq 3dfal (mapcar '(lambda ( x ) (mapcar '(lambda ( c a b ) (if (and (not (equal c a *tol*)) (not (equal a b *tol*))) (angle3d c a b) 0.0)) (append (list (last x)) (reverse (cdr (reverse x)))) x (append (cdr x) (list (car x))))) 3dfpl))
      (setq 3dfalr (mapcar '(lambda ( x ) (mapcar '(lambda ( c a b ) (if (and (not (equal c a *tol*)) (not (equal a b *tol*))) (angle3d c a b) 0.0)) (append (list (last x)) (reverse (cdr (reverse x)))) x (append (cdr x) (list (car x))))) 3dfplr))
      (setq ptdptl1 (mapcar '(lambda ( p1 d p2 ) (list p1 d p2)) espl esdl (append (cdr espl) (list (car espl)))))
      (setq tmp ptdptl1)
      (setq tmp3dfdlr (mapcar '(lambda ( x y ) (mapcar '(lambda ( p1 d p2 ) (list p1 d p2)) x y (append (cdr x) (list (car x))))) 3dfplr 3dfdlr))
      (setq tmp3dfdlrtmp tmp3dfdlr)
      (while (car tmp3dfdlr)
        (foreach tmpdl tmp3dfdlr
          (if (and (vl-some '(lambda ( x ) (or (_vl-position x tmp nil) (_vl-position (reverse x) tmp nil))) tmpdl) (not (_vl-position (_vl-position tmpdl tmp3dfdlrtmp nil) nl nil)))
            (setq n (_vl-position tmpdl tmp3dfdlrtmp nil) nl (cons n nl) tmp3dfdlr (vl-remove tmpdl tmp3dfdlr) tmp tmpdl)
          )
        )
      )
      (setq nl (reverse nl))
      (setq ipp ip)
      (setq d1 (commondst ptdptl1 (nth (car nl) tmp3dfdlrtmp)))
      (setq p1dp2l1 (car (vl-member-if '(lambda ( x ) (equal (cadr x) d1 *tol*)) ptdptl1)))
      (setq p1 (car p1dp2l1) p2 (caddr p1dp2l1) p3 (car (vl-remove p1 (vl-remove p2 espl))))
      (setq ptdptll (mapcar '(lambda ( x y ) (mapcar '(lambda ( p1 d p2 ) (list p1 d p2)) x y (append (cdr x) (list (car x))))) 3dfpl 3dfdl))
      (setq p1dl (unique (mapcar 'cadr (vl-remove-if-not '(lambda ( x ) (or (equal (car x) p1 *tol*) (equal (caddr x) p1 *tol*))) (apply 'append ptdptll)))))
      (setq r1 (cadar (vl-member-if '(lambda ( x ) (or (equal (list (car x) (caddr x)) (list p1 p3) *tol*) (equal (list (car x) (caddr x)) (list p3 p1) *tol*))) ptdptl1)))
      (setq r2 (cadar (vl-member-if '(lambda ( x ) (or (equal (list (car x) (caddr x)) (list p2 p3) *tol*) (equal (list (car x) (caddr x)) (list p3 p2) *tol*))) ptdptl1)))
      (if (not (vl-some '(lambda ( x ) (equal x r1 *tol*)) p1dl))
        (mapcar 'set (list 'p1 'p2) (list p2 p1))
      )
      (if (LM:Clockwise-p p3 p2 p1)
        (progn
          (mapcar 'set (list 'p1 'p2) (list p2 p1))
          (mapcar 'set (list 'r1 'r2) (list r2 r1))
        )
      )
      (setq esal (list (angle3d p2 p3 p1) (angle3d p3 p1 p2) (angle3d p1 p2 p3)))
      (setq esdl (list (distance p3 p1) d1 (distance p2 p3)))
      (setq esplp (list ip (setq ip (polar ip 0.0 (distance p3 p1))) (setq ip (polar ip (- pi (nth 1 esal)) d1))))
      (setq 3dfplp (cons esplp 3dfplp))
      (setq p1p (cadr esplp) p2p (caddr esplp))
      (setq p3 (car (vl-remove p1 (vl-remove p2 (nth (car nl) 3dfplr)))))
      (setq ptdptl (mapcar '(lambda ( p1 d p2 ) (list p1 d p2)) (nth (car nl) 3dfplr) (nth (car nl) 3dfdlr) (append (cdr (nth (car nl) 3dfplr)) (list (car (nth (car nl) 3dfplr))))))
      (setq d d1)
      (setq p1dp2l (car (vl-member-if '(lambda ( x ) (equal (cadr x) d *tol*)) ptdptl)))
      (setq r1 (cadar (vl-member-if '(lambda ( x ) (or (equal (list (car x) (caddr x)) (list p1 p3) *tol*) (equal (list (car x) (caddr x)) (list p3 p1) *tol*))) ptdptl)))
      (setq r2 (cadar (vl-member-if '(lambda ( x ) (or (equal (list (car x) (caddr x)) (list p2 p3) *tol*) (equal (list (car x) (caddr x)) (list p3 p2) *tol*))) ptdptl)))
      (setq p3l (LM:int-ci-ci p1p r1 p2p r2))
      (if (not (LM:Clockwise-p (car p3l) p2p p1p)) (setq p3p (car p3l)) (setq p3p (cadr p3l)))
      (setq n3dfplp (list p3p p2p p1p))
      (setq ptdptlp (list (list p3p (distance p3p p2p) p2p) (list p2p (distance p2p p1p) p1p) (list p1p (distance p1p p3p) p3p)))
      (setq ptdptlpp (cons ptdptlp ptdptlpp))
      (setq 3dfplp (cons n3dfplp 3dfplp))
      (foreach n (vl-remove (car nl) nl)
        (setq n3dfpl (nth n 3dfplr) n3dfdl (nth n 3dfdlr) n3dfal (nth n 3dfalr))
        (setq ptdptl (mapcar '(lambda ( p1 d p2 ) (list p1 d p2)) n3dfpl n3dfdl (append (cdr n3dfpl) (list (car n3dfpl)))))
        (setq d (commondst
                  (mapcar '(lambda ( p1 d p2 ) (list p1 d p2)) (nth (nth (1- (_vl-position n nl nil)) nl) 3dfplr) (nth (nth (1- (_vl-position n nl nil)) nl) 3dfdlr) (append (cdr (nth (nth (1- (_vl-position n nl nil)) nl) 3dfplr)) (list (car (nth (nth (1- (_vl-position n nl nil)) nl) 3dfplr)))))
                  ptdptl
                )
        )
        (setq p1dp2l (car (vl-member-if '(lambda ( x ) (equal (cadr x) d *tol*)) ptdptl)))
        (setq p1 (car p1dp2l) p2 (caddr p1dp2l) p3 (car (vl-remove p1 (vl-remove p2 n3dfpl))))
        (setq r1 (cadar (vl-member-if '(lambda ( x ) (or (equal (list (car x) (caddr x)) (list p1 p3) *tol*) (equal (list (car x) (caddr x)) (list p3 p1) *tol*))) ptdptl)))
        (setq r2 (cadar (vl-member-if '(lambda ( x ) (or (equal (list (car x) (caddr x)) (list p2 p3) *tol*) (equal (list (car x) (caddr x)) (list p3 p2) *tol*))) ptdptl)))
        (if (LM:Clockwise-p p3 p2 p1)
          (progn
            (mapcar 'set (list 'p1 'p2) (list p2 p1))
            (mapcar 'set (list 'r1 'r2) (list r2 r1))
          )
        )
        (setq p1dl (unique (mapcar 'cadr (vl-remove-if-not '(lambda ( x ) (or (equal (car x) p1 *tol*) (equal (caddr x) p1 *tol*))) (apply 'append ptdptll)))))
        (setq p1dp2lp (car (vl-member-if '(lambda ( x ) (equal (cadr x) d *tol*)) ptdptlp)))
        (setq p1p (car p1dp2lp) p2p (caddr p1dp2lp))
        (if ptdptlpp
          (progn
            (setq p1pdl (unique (mapcar 'cadr (vl-remove-if-not '(lambda ( x ) (or (equal (car x) p1p *tol*) (equal (caddr x) p1p *tol*))) (apply 'append ptdptlpp)))))
            (foreach d p1dl
              (setq p1pdl (vl-remove-if '(lambda ( x ) (equal x d *tol*)) p1pdl))
            )
            (if p1pdl
              (mapcar 'set (list 'p1p 'p2p) (list p2p p1p))
            )
          )
        )
        (setq p3l (LM:int-ci-ci p1p r1 p2p r2))
        (if (not (LM:Clockwise-p (caar 3dfplp) (cadar 3dfplp) (caddar 3dfplp)))
          (mapcar 'set (list 'p1p 'p2p) (list p2p p1p))
        )
        (if (not (LM:Clockwise-p (car p3l) p2p p1p)) (setq p3p (car p3l)) (setq p3p (cadr p3l)))
        (setq n3dfplp (list p3p p2p p1p))
        (setq ptdptlp (list (list p3p (distance p3p p2p) p2p) (list p2p (distance p2p p1p) p1p) (list p1p (distance p1p p3p) p3p)))
        (setq ptdptlpp (cons ptdptlp ptdptlpp))
        (setq 3dfplp (cons n3dfplp 3dfplp))
      )
      (foreach 3df 3dfplp
        (entmake (list '(0 . "3DFACE") (cons 10 (car 3df)) (cons 11 (car 3df)) (cons 12 (cadr 3df)) (cons 13 (caddr 3df))))
      )
    )
    (prompt "\nEmpty sel.set... Retry routine again with some 3DFACE entities selected...")
  )
  (*error* nil)
)

[carlos_m_gil_p]

Hello Brother how are you.

Again thank you very much.

Your choice seems very interesting.

Also I am using, when it has branches.

Let's see if anyone else is encouraged to give other opinions more.

I wish we could finish.

Thank you.

[marko_ribar]

Hi, no branches... Little more code furnishing - you're prompted to choose right branch of first/last 3dface and lisp will position correctly unfloded lattice according to insertion point and X axis angle = 0.0 degree... Also if missed picking it will loop til correct input... Also should not error even if selection is larger - more branches, but it will not compute them... So this is I hope my last post for today and if you must do it with branches, I suggest that you choose correct branch and add one by one side by side and finally gather them using align command... So long from me, regards...

(defun c:xxx ( / *error* LM:int-ci-ci LM:Clockwise-p commondst unique _vl-position unit acos angle3d *tol* osm f ss p es ip espl esdl esal 3dfpl 3dfplr 3dfdl 3dfdlr 3dfal 3dfalr tmp tmp3dfdlr tmp3dfdlrtmp k n nl ipp ptdptl1 d1 p1dp2l1 p1 p2 p3 ptdptll p1dl r1 r2 esplp 3dfplp p1p p2p p3l p3p n3dfplp ptdptlp ptdptlpp 3dfplp n3dfpl n3dfdl n3dfal ptdptl d p1dp2l p1dp2lp p1pdl )

  (defun *error* ( m )
    (if osm (setvar 'osmode osm))
    (if f (command "_.UCS" "_P"))
    (if m (prompt m))
    (princ)
  )

  ;; 2-Circle Intersection (trans version)  -  Lee Mac
  ;; Returns the point(s) of intersection between two circles
  ;; with centres c1,c2 and radii r1,r2

  (defun LM:int-ci-ci ( c1 r1 c2 r2 / *n* *d1* *x* *z* )
    (if
      (and
        (< (setq *d1* (distance c1 c2)) (+ r1 r2))
        (< (abs (- r1 r2)) *d1*)
      )
      (progn
        (setq *n* (mapcar '- c2 c1))
        (setq c1 (trans c1 0 *n*))
        (setq *z* (/ (- (+ (* r1 r1) (* *d1* *d1*)) (* r2 r2)) (+ *d1* *d1*)))
        (if (equal *z* r1 1e-8)
          (list (trans (list (car c1) (cadr c1) (+ (caddr c1) *z*)) *n* 0))
          (progn
            (setq *x* (sqrt (- (* r1 r1) (* *z* *z*))))
            (list
              (trans (list (- (car c1) *x*) (cadr c1) (+ (caddr c1) *z*)) *n* 0)
              (trans (list (+ (car c1) *x*) (cadr c1) (+ (caddr c1) *z*)) *n* 0)
            )
          )
        )
      )
    )
  )

  ;; Clockwise-p  -  Lee Mac
  ;; Returns T if p1,p2,p3 are clockwise oriented or collinear

  (defun LM:Clockwise-p ( p1 p2 p3 )
    (< (-  (* (- (car  p2) (car  p1)) (- (cadr p3) (cadr p1)))
           (* (- (cadr p2) (cadr p1)) (- (car  p3) (car  p1)))
       )
       1e-8
    )
  )

  (defun commondst ( l1 l2 / *tol* r ) ;; l1 = ((p11 d1 p21) (p12 d2 p22) (p13 d3 p23)) ; l2 = ((p11 d1 p21) (p12 d2 p22) (p13 d3 p23))
    (or *tol* (setq *tol* 1e-6))
    (foreach e l1
      (if (vl-member-if '(lambda ( x ) (or (equal e x *tol*) (equal e (reverse x) *tol*))) l2)
        (setq r e)
      )
    )
    (cadr r)
  )

  (defun unique ( l / *tol* )
    (or *tol* (setq *tol* 1e-6))
    (if l (cons (car l) (unique (vl-remove-if '(lambda ( x ) (equal x (car l) *tol*)) (cdr l)))))
  )

  (defun _vl-position ( e l *z* / *tol* ) ;; *z* must be specified as nil ;;
    (or *tol* (setq *tol* 1e-6))
    (if (null *z*)
      (setq *z* 0)
    )
    (if (not (equal e (car l) *tol*))
      (progn
        (setq *z* (1+ *z*))
        (if (cdr l)
          (_vl-position e (cdr l) *z*)
          (setq *z* nil)
        )
      )
      *z*
    )
  )

  (defun unit ( v )
    (mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)
  )

  (defun acos ( x )
    (cond
      ( (equal x 1.0 1e-8)
        0.0
      )
      ( (equal x -1.0 1e-8)
        pi
      )
      ( (equal x 0.0 1e-8)
        (/ pi 2.0)
      )
      ( (equal x -0.0 1e-8)
        (* 3.0 (/ pi 2.0))
      )
      ( t
        (atan (/ (sqrt (- 1.0 (* x x))) x))
      )
    )
  )

  (defun angle3d ( p1 por p2 / vec1 vec2 dd ang )
    (setq vec1 (unit (mapcar '- p1 por))
          vec2 (unit (mapcar '- p2 por))
          dd (distance vec1 vec2)
          ang (acos (- 1.0 (/ (expt dd 2) 2.0)))
    )
    (if (minusp ang) (+ ang pi) ang)
  )

  (setq *tol* 1e-6)
  (setq osm (getvar 'osmode))
  (if (eq (getvar 'worlducs) 0)
    (progn
      (command "_.UCS" "_W")
      (setq f t)
    )
  )
  (prompt "\nSelect TRIANGULAR 3D FACES OF LINEAR LATTICE in 3D space to unfold them to the ground level 0.0...")
  (setq ss (ssget '((0 . "3DFACE"))))
  (if ss
    (progn
      (setvar 'osmode 512)
      (setq p (getpoint "\nPick edge from lattice contours you want me to align to X axis vector of WCS (important - first or last RIGHT BRANCH OF 3DFACE OF LINEAR LATTICE)..."))
      (while (vl-catch-all-error-p (setq es (vl-catch-all-apply 'nentselp (list p))))
        (prompt "\nMissed point pick or point specification... Try again...")
        (setq p (getpoint "\nPick edge from lattice contours you want me to align to X axis vector of WCS (important - first or last RIGHT BRANCH OF 3DFACE OF LINEAR LATTICE)..."))
      )
      (setq ip (getpoint "\nPick or specify insertion point in WCS plane : "))
      (while (not (equal (caddr ip) 0.0 *tol*))
        (prompt "\nPicked or specified insertion point not in WCS... Please retry specification of insertion point...")
        (setq ip (getpoint "\nPick or specify insertion point in WCS plane : "))
      )
      (setq espl (unique (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (_vl-position (car x) '(10 11 12 13) nil)) (entget (car es))))))
      (if (LM:Clockwise-p (car espl) (cadr espl) (caddr espl))
        (setq espl (reverse espl))
      )
      (setq k -1)
      (while (not (equal (distance (nth (if (= (setq k (1+ k)) 3) (setq k 0) k) espl) (nth (if (= (1+ k) 3) 0 (1+ k)) espl)) (+ (distance (nth k espl) p) (distance p (nth (if (= (1+ k) 3) 0 (1+ k)) espl))) *tol*)))
      (setq espl (list (nth k espl) (nth (if (= (setq k (1+ k)) 3) (setq k 0) k) espl) (nth (if (= (setq k (1+ k)) 3) (setq k 0) k) espl)))
      (setq esdl (mapcar '(lambda ( a b ) (distance a b)) espl (append (cdr espl) (list (car espl)))))
      (setq esal (mapcar '(lambda ( c a b ) (if (and (not (equal c a *tol*)) (not (equal a b *tol*))) (angle3d c a b) 0.0)) (append (list (last espl)) (reverse (cdr (reverse espl)))) espl (append (cdr espl) (list (car espl)))))
      (setq 3dfpl (mapcar '(lambda ( x ) (unique (mapcar 'cdr (vl-remove-if-not '(lambda ( y ) (_vl-position (car y) '(10 11 12 13) nil)) (entget x))))) (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
      (setq 3dfplr (vl-remove-if '(lambda ( x ) (and (_vl-position (car espl) x nil) (_vl-position (cadr espl) x nil) (_vl-position (caddr espl) x nil))) 3dfpl))
      (setq 3dfdl (mapcar '(lambda ( x ) (mapcar '(lambda ( a b ) (distance a b)) x (append (cdr x) (list (car x))))) 3dfpl))
      (setq 3dfdlr (mapcar '(lambda ( x ) (mapcar '(lambda ( a b ) (distance a b)) x (append (cdr x) (list (car x))))) 3dfplr))
      (setq 3dfal (mapcar '(lambda ( x ) (mapcar '(lambda ( c a b ) (if (and (not (equal c a *tol*)) (not (equal a b *tol*))) (angle3d c a b) 0.0)) (append (list (last x)) (reverse (cdr (reverse x)))) x (append (cdr x) (list (car x))))) 3dfpl))
      (setq 3dfalr (mapcar '(lambda ( x ) (mapcar '(lambda ( c a b ) (if (and (not (equal c a *tol*)) (not (equal a b *tol*))) (angle3d c a b) 0.0)) (append (list (last x)) (reverse (cdr (reverse x)))) x (append (cdr x) (list (car x))))) 3dfplr))
      (setq ptdptl1 (mapcar '(lambda ( p1 d p2 ) (list p1 d p2)) espl esdl (append (cdr espl) (list (car espl)))))
      (setq tmp ptdptl1)
      (setq tmp3dfdlr (mapcar '(lambda ( x y ) (mapcar '(lambda ( p1 d p2 ) (list p1 d p2)) x y (append (cdr x) (list (car x))))) 3dfplr 3dfdlr))
      (setq tmp3dfdlrtmp tmp3dfdlr)
      (setq k (length tmp3dfdlr))
      (while (and (car tmp3dfdlr) (> (setq k (1- k)) 0))
        (foreach tmpdl tmp3dfdlr
          (if (and (vl-some '(lambda ( x ) (or (_vl-position x tmp nil) (_vl-position (reverse x) tmp nil))) tmpdl) (not (_vl-position (_vl-position tmpdl tmp3dfdlrtmp nil) nl nil)))
            (setq n (_vl-position tmpdl tmp3dfdlrtmp nil) nl (cons n nl) tmp3dfdlr (vl-remove tmpdl tmp3dfdlr) tmp tmpdl)
          )
        )
      )
      (setq nl (reverse nl))
      (setq ipp ip)
      (setq d1 (commondst ptdptl1 (nth (car nl) tmp3dfdlrtmp)))
      (setq p1dp2l1 (car (vl-member-if '(lambda ( x ) (equal (cadr x) d1 *tol*)) ptdptl1)))
      (setq p1 (car p1dp2l1) p2 (caddr p1dp2l1) p3 (car (vl-remove p1 (vl-remove p2 espl))))
      (setq ptdptll (mapcar '(lambda ( x y ) (mapcar '(lambda ( p1 d p2 ) (list p1 d p2)) x y (append (cdr x) (list (car x))))) 3dfpl 3dfdl))
      (setq p1dl (unique (mapcar 'cadr (vl-remove-if-not '(lambda ( x ) (or (equal (car x) p1 *tol*) (equal (caddr x) p1 *tol*))) (apply 'append ptdptll)))))
      (setq r1 (cadar (vl-member-if '(lambda ( x ) (or (equal (list (car x) (caddr x)) (list p1 p3) *tol*) (equal (list (car x) (caddr x)) (list p3 p1) *tol*))) ptdptl1)))
      (setq r2 (cadar (vl-member-if '(lambda ( x ) (or (equal (list (car x) (caddr x)) (list p2 p3) *tol*) (equal (list (car x) (caddr x)) (list p3 p2) *tol*))) ptdptl1)))
      (if (not (vl-some '(lambda ( x ) (equal x r1 *tol*)) p1dl))
        (mapcar 'set (list 'p1 'p2) (list p2 p1))
      )
      (if (LM:Clockwise-p p3 p1 p2)
        (progn
          (mapcar 'set (list 'p1 'p2) (list p2 p1))
          (mapcar 'set (list 'r1 'r2) (list r2 r1))
        )
      )
      (setq esal (list (angle3d p2 p3 p1) (angle3d p3 p1 p2) (angle3d p1 p2 p3)))
      (setq esdl (list (distance p3 p1) d1 (distance p2 p3)))
      (setq esplp (list ip (setq ip (polar ip 0.0 (distance p3 p1))) (setq ip (polar ip (- pi (nth 1 esal)) d1))))
      (setq 3dfplp (cons esplp 3dfplp))
      (setq p1p (cadr esplp) p2p (caddr esplp))
      (setq p3 (car (vl-remove p1 (vl-remove p2 (nth (car nl) 3dfplr)))))
      (setq ptdptl (mapcar '(lambda ( p1 d p2 ) (list p1 d p2)) (nth (car nl) 3dfplr) (nth (car nl) 3dfdlr) (append (cdr (nth (car nl) 3dfplr)) (list (car (nth (car nl) 3dfplr))))))
      (setq d d1)
      (setq p1dp2l (car (vl-member-if '(lambda ( x ) (equal (cadr x) d *tol*)) ptdptl)))
      (setq r1 (cadar (vl-member-if '(lambda ( x ) (or (equal (list (car x) (caddr x)) (list p1 p3) *tol*) (equal (list (car x) (caddr x)) (list p3 p1) *tol*))) ptdptl)))
      (setq r2 (cadar (vl-member-if '(lambda ( x ) (or (equal (list (car x) (caddr x)) (list p2 p3) *tol*) (equal (list (car x) (caddr x)) (list p3 p2) *tol*))) ptdptl)))
      (setq p3l (LM:int-ci-ci p1p r1 p2p r2))
      (if (not (LM:Clockwise-p (car p3l) p2p p1p)) (setq p3p (car p3l)) (setq p3p (cadr p3l)))
      (setq n3dfplp (list p3p p2p p1p))
      (setq ptdptlp (list (list p3p (distance p3p p2p) p2p) (list p2p (distance p2p p1p) p1p) (list p1p (distance p1p p3p) p3p)))
      (setq ptdptlpp (cons ptdptlp ptdptlpp))
      (setq 3dfplp (cons n3dfplp 3dfplp))
      (foreach n (vl-remove (car nl) nl)
        (setq n3dfpl (nth n 3dfplr) n3dfdl (nth n 3dfdlr) n3dfal (nth n 3dfalr))
        (setq ptdptl (mapcar '(lambda ( p1 d p2 ) (list p1 d p2)) n3dfpl n3dfdl (append (cdr n3dfpl) (list (car n3dfpl)))))
        (setq d (commondst
                  (mapcar '(lambda ( p1 d p2 ) (list p1 d p2)) (nth (nth (1- (_vl-position n nl nil)) nl) 3dfplr) (nth (nth (1- (_vl-position n nl nil)) nl) 3dfdlr) (append (cdr (nth (nth (1- (_vl-position n nl nil)) nl) 3dfplr)) (list (car (nth (nth (1- (_vl-position n nl nil)) nl) 3dfplr)))))
                  ptdptl
                )
        )
        (setq p1dp2l (car (vl-member-if '(lambda ( x ) (equal (cadr x) d *tol*)) ptdptl)))
        (setq p1 (car p1dp2l) p2 (caddr p1dp2l) p3 (car (vl-remove p1 (vl-remove p2 n3dfpl))))
        (setq r1 (cadar (vl-member-if '(lambda ( x ) (or (equal (list (car x) (caddr x)) (list p1 p3) *tol*) (equal (list (car x) (caddr x)) (list p3 p1) *tol*))) ptdptl)))
        (setq r2 (cadar (vl-member-if '(lambda ( x ) (or (equal (list (car x) (caddr x)) (list p2 p3) *tol*) (equal (list (car x) (caddr x)) (list p3 p2) *tol*))) ptdptl)))
        (if (LM:Clockwise-p p3 p1 p2)
          (progn
            (mapcar 'set (list 'p1 'p2) (list p2 p1))
            (mapcar 'set (list 'r1 'r2) (list r2 r1))
          )
        )
        (setq p1dl (unique (mapcar 'cadr (vl-remove-if-not '(lambda ( x ) (or (equal (car x) p1 *tol*) (equal (caddr x) p1 *tol*))) (apply 'append ptdptll)))))
        (setq p1dp2lp (car (vl-member-if '(lambda ( x ) (equal (cadr x) d *tol*)) ptdptlp)))
        (setq p1p (car p1dp2lp) p2p (caddr p1dp2lp))
        (if ptdptlpp
          (progn
            (setq p1pdl (unique (mapcar 'cadr (vl-remove-if-not '(lambda ( x ) (or (equal (car x) p1p *tol*) (equal (caddr x) p1p *tol*))) (apply 'append ptdptlpp)))))
            (foreach d p1dl
              (setq p1pdl (vl-remove-if '(lambda ( x ) (equal x d *tol*)) p1pdl))
            )
            (if p1pdl
              (mapcar 'set (list 'p1p 'p2p) (list p2p p1p))
            )
          )
        )
        (setq p3l (LM:int-ci-ci p1p r1 p2p r2))
        (if (not (LM:Clockwise-p (caar 3dfplp) (cadar 3dfplp) (caddar 3dfplp)))
          (mapcar 'set (list 'p1p 'p2p) (list p2p p1p))
        )
        (if (not (LM:Clockwise-p (car p3l) p2p p1p)) (setq p3p (car p3l)) (setq p3p (cadr p3l)))
        (setq n3dfplp (list p3p p2p p1p))
        (setq ptdptlp (list (list p3p (distance p3p p2p) p2p) (list p2p (distance p2p p1p) p1p) (list p1p (distance p1p p3p) p3p)))
        (setq ptdptlpp (cons ptdptlp ptdptlpp))
        (setq 3dfplp (cons n3dfplp 3dfplp))
      )
      (foreach 3df 3dfplp
        (entmake (list '(0 . "3DFACE") (cons 10 (car 3df)) (cons 11 (car 3df)) (cons 12 (cadr 3df)) (cons 13 (caddr 3df))))
      )
    )
    (prompt "\nEmpty sel.set... Retry routine again with some 3DFACE entities selected...")
  )
  (*error* nil)
)

[marko_ribar]

Even more furnishing... HTH, M.R.

(defun c:xxx ( / *error* LM:int-ci-ci LM:Clockwise-p commondst unique _vl-position unit acos angle3d *tol* osm f ss p es ip espl esdl esal 3dfpl 3dfplr 3dfdl 3dfdlr 3dfal 3dfalr tmp tmp3dfdlr tmp3dfdlrtmp k n nl ipp ptdptl1 d1 p1dp2l1 p1 p2 p3 ptdptll p1dl r1 r2 esplp 3dfplp p1p p2p p3l p3p n3dfplp ptdptlp ptdptlpp 3dfplp n3dfpl n3dfdl n3dfal ptdptl d p1dp2l p1dp2lp p1pdl )

  (defun *error* ( m )
    (if osm (setvar 'osmode osm))
    (if f (command "_.UCS" "_P"))
    (if m (prompt m))
    (princ)
  )

  ;; 2-Circle Intersection (trans version)  -  Lee Mac
  ;; Returns the point(s) of intersection between two circles
  ;; with centres c1,c2 and radii r1,r2

  (defun LM:int-ci-ci ( c1 r1 c2 r2 / *n* *d1* *x* *z* )
    (if
      (and
        (< (setq *d1* (distance c1 c2)) (+ r1 r2))
        (< (abs (- r1 r2)) *d1*)
      )
      (progn
        (setq *n* (mapcar '- c2 c1))
        (setq c1 (trans c1 0 *n*))
        (setq *z* (/ (- (+ (* r1 r1) (* *d1* *d1*)) (* r2 r2)) (+ *d1* *d1*)))
        (if (equal *z* r1 1e-8)
          (list (trans (list (car c1) (cadr c1) (+ (caddr c1) *z*)) *n* 0))
          (progn
            (setq *x* (sqrt (- (* r1 r1) (* *z* *z*))))
            (list
              (trans (list (- (car c1) *x*) (cadr c1) (+ (caddr c1) *z*)) *n* 0)
              (trans (list (+ (car c1) *x*) (cadr c1) (+ (caddr c1) *z*)) *n* 0)
            )
          )
        )
      )
    )
  )

  ;; Clockwise-p  -  Lee Mac
  ;; Returns T if p1,p2,p3 are clockwise oriented or collinear

  (defun LM:Clockwise-p ( p1 p2 p3 )
    (< (-  (* (- (car  p2) (car  p1)) (- (cadr p3) (cadr p1)))
           (* (- (cadr p2) (cadr p1)) (- (car  p3) (car  p1)))
       )
       1e-8
    )
  )

  (defun commondst ( l1 l2 / *tol* r ) ;; l1 = ((p11 d1 p21) (p12 d2 p22) (p13 d3 p23)) ; l2 = ((p11 d1 p21) (p12 d2 p22) (p13 d3 p23))
    (or *tol* (setq *tol* 1e-6))
    (foreach e l1
      (if (vl-member-if '(lambda ( x ) (or (equal e x *tol*) (equal e (reverse x) *tol*))) l2)
        (setq r e)
      )
    )
    (cadr r)
  )

  (defun unique ( l / *tol* )
    (or *tol* (setq *tol* 1e-6))
    (if l (cons (car l) (unique (vl-remove-if '(lambda ( x ) (equal x (car l) *tol*)) (cdr l)))))
  )

  (defun _vl-position ( e l *z* / *tol* ) ;; *z* must be specified as nil ;;
    (or *tol* (setq *tol* 1e-6))
    (if (null *z*)
      (setq *z* 0)
    )
    (if (not (equal e (car l) *tol*))
      (progn
        (setq *z* (1+ *z*))
        (if (cdr l)
          (_vl-position e (cdr l) *z*)
          (setq *z* nil)
        )
      )
      *z*
    )
  )

  (defun unit ( v )
    (mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)
  )

  (defun acos ( x )
    (cond
      ( (equal x 1.0 1e-8)
        0.0
      )
      ( (equal x -1.0 1e-8)
        pi
      )
      ( (equal x 0.0 1e-8)
        (/ pi 2.0)
      )
      ( (equal x -0.0 1e-8)
        (* 3.0 (/ pi 2.0))
      )
      ( t
        (atan (/ (sqrt (- 1.0 (* x x))) x))
      )
    )
  )

  (defun angle3d ( p1 por p2 / vec1 vec2 dd ang )
    (setq vec1 (unit (mapcar '- p1 por))
          vec2 (unit (mapcar '- p2 por))
          dd (distance vec1 vec2)
          ang (acos (- 1.0 (/ (expt dd 2) 2.0)))
    )
    (if (minusp ang) (+ ang pi) ang)
  )

  (setq *tol* 1e-6)
  (setq osm (getvar 'osmode))
  (if (eq (getvar 'worlducs) 0)
    (progn
      (command "_.UCS" "_W")
      (setq f t)
    )
  )
  (prompt "\nSelect TRIANGULAR 3D FACES OF LINEAR LATTICE in 3D space to unfold them to the ground level 0.0...")
  (setq ss (ssget '((0 . "3DFACE"))))
  (if ss
    (progn
      (setvar 'osmode 512)
      (setq p (getpoint "\nPick edge from lattice contours you want me to align to X axis vector of WCS (important - first or last RIGHT BRANCH OF 3DFACE OF LINEAR LATTICE)..."))
      (while (and (not (setq es (nentselp p))) (if es (/= (cdr (assoc 0 (entget (car es)))) "3DFACE") t))
        (prompt "\nMissed point pick or point specification or picked point belong to entity other than 3DFACE... Try again...")
        (setq p (getpoint "\nPick edge from lattice contours you want me to align to X axis vector of WCS (important - first or last RIGHT BRANCH OF 3DFACE OF LINEAR LATTICE)..."))
      )
      (if (and (= (sslength (ssget "_C" p p '((0 . "3DFACE")))) 2) (not (ssmemb (car es) ss)))
        (setq es (list (ssname (ssdel (car es) (ssget "_P")) 0)))
      )
      (setq ip (getpoint "\nPick or specify insertion point in WCS plane : "))
      (while (not (equal (caddr ip) 0.0 *tol*))
        (prompt "\nPicked or specified insertion point not in WCS... Please retry specification of insertion point...")
        (setq ip (getpoint "\nPick or specify insertion point in WCS plane : "))
      )
      (setq espl (unique (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (_vl-position (car x) '(10 11 12 13) nil)) (entget (car es))))))
      (if (LM:Clockwise-p (car espl) (cadr espl) (caddr espl))
        (setq espl (reverse espl))
      )
      (setq k -1)
      (while (not (equal (distance (nth (if (= (setq k (1+ k)) 3) (setq k 0) k) espl) (nth (if (= (1+ k) 3) 0 (1+ k)) espl)) (+ (distance (nth k espl) p) (distance p (nth (if (= (1+ k) 3) 0 (1+ k)) espl))) *tol*)))
      (setq espl (list (nth k espl) (nth (if (= (setq k (1+ k)) 3) (setq k 0) k) espl) (nth (if (= (setq k (1+ k)) 3) (setq k 0) k) espl)))
      (setq esdl (mapcar '(lambda ( a b ) (distance a b)) espl (append (cdr espl) (list (car espl)))))
      (setq esal (mapcar '(lambda ( c a b ) (if (and (not (equal c a *tol*)) (not (equal a b *tol*))) (angle3d c a b) 0.0)) (append (list (last espl)) (reverse (cdr (reverse espl)))) espl (append (cdr espl) (list (car espl)))))
      (setq 3dfpl (mapcar '(lambda ( x ) (unique (mapcar 'cdr (vl-remove-if-not '(lambda ( y ) (_vl-position (car y) '(10 11 12 13) nil)) (entget x))))) (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
      (setq 3dfplr (vl-remove-if '(lambda ( x ) (and (_vl-position (car espl) x nil) (_vl-position (cadr espl) x nil) (_vl-position (caddr espl) x nil))) 3dfpl))
      (setq 3dfdl (mapcar '(lambda ( x ) (mapcar '(lambda ( a b ) (distance a b)) x (append (cdr x) (list (car x))))) 3dfpl))
      (setq 3dfdlr (mapcar '(lambda ( x ) (mapcar '(lambda ( a b ) (distance a b)) x (append (cdr x) (list (car x))))) 3dfplr))
      (setq 3dfal (mapcar '(lambda ( x ) (mapcar '(lambda ( c a b ) (if (and (not (equal c a *tol*)) (not (equal a b *tol*))) (angle3d c a b) 0.0)) (append (list (last x)) (reverse (cdr (reverse x)))) x (append (cdr x) (list (car x))))) 3dfpl))
      (setq 3dfalr (mapcar '(lambda ( x ) (mapcar '(lambda ( c a b ) (if (and (not (equal c a *tol*)) (not (equal a b *tol*))) (angle3d c a b) 0.0)) (append (list (last x)) (reverse (cdr (reverse x)))) x (append (cdr x) (list (car x))))) 3dfplr))
      (setq ptdptl1 (mapcar '(lambda ( p1 d p2 ) (list p1 d p2)) espl esdl (append (cdr espl) (list (car espl)))))
      (setq tmp ptdptl1)
      (setq tmp3dfdlr (mapcar '(lambda ( x y ) (mapcar '(lambda ( p1 d p2 ) (list p1 d p2)) x y (append (cdr x) (list (car x))))) 3dfplr 3dfdlr))
      (setq tmp3dfdlrtmp tmp3dfdlr)
      (setq k (length tmp3dfdlr))
      (while (and (car tmp3dfdlr) (>= (setq k (1- k)) 0))
        (foreach tmpdl tmp3dfdlr
          (if (and (vl-some '(lambda ( x ) (or (_vl-position x tmp nil) (_vl-position (reverse x) tmp nil))) tmpdl) (not (_vl-position (_vl-position tmpdl tmp3dfdlrtmp nil) nl nil)))
            (setq n (_vl-position tmpdl tmp3dfdlrtmp nil) nl (cons n nl) tmp3dfdlr (vl-remove tmpdl tmp3dfdlr) tmp tmpdl)
          )
        )
      )
      (setq nl (reverse nl))
      (setq ipp ip)
      (if (vl-catch-all-error-p (setq d1 (vl-catch-all-apply 'commondst (list ptdptl1 (vl-catch-all-apply 'nth (list (car nl) tmp3dfdlrtmp))))))
        (setq d1 (nth 1 esdl))
      )
      (setq p1dp2l1 (car (vl-member-if '(lambda ( x ) (equal (cadr x) d1 *tol*)) ptdptl1)))
      (setq p1 (car p1dp2l1) p2 (caddr p1dp2l1) p3 (car (vl-remove p1 (vl-remove p2 espl))))
      (setq ptdptll (mapcar '(lambda ( x y ) (mapcar '(lambda ( p1 d p2 ) (list p1 d p2)) x y (append (cdr x) (list (car x))))) 3dfpl 3dfdl))
      (setq p1dl (unique (mapcar 'cadr (vl-remove-if-not '(lambda ( x ) (or (equal (car x) p1 *tol*) (equal (caddr x) p1 *tol*))) (apply 'append ptdptll)))))
      (setq r1 (cadar (vl-member-if '(lambda ( x ) (or (equal (list (car x) (caddr x)) (list p1 p3) *tol*) (equal (list (car x) (caddr x)) (list p3 p1) *tol*))) ptdptl1)))
      (setq r2 (cadar (vl-member-if '(lambda ( x ) (or (equal (list (car x) (caddr x)) (list p2 p3) *tol*) (equal (list (car x) (caddr x)) (list p3 p2) *tol*))) ptdptl1)))
      (if (not (vl-some '(lambda ( x ) (equal x r1 *tol*)) p1dl))
        (mapcar 'set (list 'p1 'p2) (list p2 p1))
      )
      (if (LM:Clockwise-p p3 p1 p2)
        (progn
          (mapcar 'set (list 'p1 'p2) (list p2 p1))
          (mapcar 'set (list 'r1 'r2) (list r2 r1))
        )
      )
      (setq esal (list (angle3d p2 p3 p1) (angle3d p3 p1 p2) (angle3d p1 p2 p3)))
      (setq esdl (list (distance p3 p1) d1 (distance p2 p3)))
      (setq esplp (list ip (setq ip (polar ip 0.0 (distance p3 p1))) (setq ip (polar ip (- pi (nth 1 esal)) d1))))
      (setq 3dfplp (cons esplp 3dfplp))
      (setq p1p (cadr esplp) p2p (caddr esplp))
      (if (not (vl-catch-all-error-p (vl-catch-all-apply 'nth (list (car nl) 3dfplr))))
        (progn
          (setq p3 (car (vl-remove p1 (vl-remove p2 (nth (car nl) 3dfplr)))))
          (setq ptdptl (mapcar '(lambda ( p1 d p2 ) (list p1 d p2)) (nth (car nl) 3dfplr) (nth (car nl) 3dfdlr) (append (cdr (nth (car nl) 3dfplr)) (list (car (nth (car nl) 3dfplr))))))
          (setq d d1)
          (setq p1dp2l (car (vl-member-if '(lambda ( x ) (equal (cadr x) d *tol*)) ptdptl)))
          (setq r1 (cadar (vl-member-if '(lambda ( x ) (or (equal (list (car x) (caddr x)) (list p1 p3) *tol*) (equal (list (car x) (caddr x)) (list p3 p1) *tol*))) ptdptl)))
          (setq r2 (cadar (vl-member-if '(lambda ( x ) (or (equal (list (car x) (caddr x)) (list p2 p3) *tol*) (equal (list (car x) (caddr x)) (list p3 p2) *tol*))) ptdptl)))
          (setq p3l (LM:int-ci-ci p1p r1 p2p r2))
          (if (not (LM:Clockwise-p (car p3l) p2p p1p)) (setq p3p (car p3l)) (setq p3p (cadr p3l)))
          (setq n3dfplp (list p3p p2p p1p))
          (setq ptdptlp (list (list p3p (distance p3p p2p) p2p) (list p2p (distance p2p p1p) p1p) (list p1p (distance p1p p3p) p3p)))
          (setq ptdptlpp (cons ptdptlp ptdptlpp))
          (setq 3dfplp (cons n3dfplp 3dfplp))
          (foreach n (vl-remove (car nl) nl)
            (setq n3dfpl (nth n 3dfplr) n3dfdl (nth n 3dfdlr) n3dfal (nth n 3dfalr))
            (setq ptdptl (mapcar '(lambda ( p1 d p2 ) (list p1 d p2)) n3dfpl n3dfdl (append (cdr n3dfpl) (list (car n3dfpl)))))
            (setq d (commondst
                      (mapcar '(lambda ( p1 d p2 ) (list p1 d p2)) (nth (nth (1- (_vl-position n nl nil)) nl) 3dfplr) (nth (nth (1- (_vl-position n nl nil)) nl) 3dfdlr) (append (cdr (nth (nth (1- (_vl-position n nl nil)) nl) 3dfplr)) (list (car (nth (nth (1- (_vl-position n nl nil)) nl) 3dfplr)))))
                      ptdptl
                    )
            )
            (setq p1dp2l (car (vl-member-if '(lambda ( x ) (equal (cadr x) d *tol*)) ptdptl)))
            (setq p1 (car p1dp2l) p2 (caddr p1dp2l) p3 (car (vl-remove p1 (vl-remove p2 n3dfpl))))
            (setq r1 (cadar (vl-member-if '(lambda ( x ) (or (equal (list (car x) (caddr x)) (list p1 p3) *tol*) (equal (list (car x) (caddr x)) (list p3 p1) *tol*))) ptdptl)))
            (setq r2 (cadar (vl-member-if '(lambda ( x ) (or (equal (list (car x) (caddr x)) (list p2 p3) *tol*) (equal (list (car x) (caddr x)) (list p3 p2) *tol*))) ptdptl)))
            (if (LM:Clockwise-p p3 p1 p2)
              (progn
                (mapcar 'set (list 'p1 'p2) (list p2 p1))
                (mapcar 'set (list 'r1 'r2) (list r2 r1))
              )
            )
            (setq p1dl (unique (mapcar 'cadr (vl-remove-if-not '(lambda ( x ) (or (equal (car x) p1 *tol*) (equal (caddr x) p1 *tol*))) (apply 'append ptdptll)))))
            (setq p1dp2lp (car (vl-member-if '(lambda ( x ) (equal (cadr x) d *tol*)) ptdptlp)))
            (setq p1p (car p1dp2lp) p2p (caddr p1dp2lp))
            (if ptdptlpp
              (progn
                (setq p1pdl (unique (mapcar 'cadr (vl-remove-if-not '(lambda ( x ) (or (equal (car x) p1p *tol*) (equal (caddr x) p1p *tol*))) (apply 'append ptdptlpp)))))
                (foreach d p1dl
                  (setq p1pdl (vl-remove-if '(lambda ( x ) (equal x d *tol*)) p1pdl))
                )
                (if p1pdl
                  (mapcar 'set (list 'p1p 'p2p) (list p2p p1p))
                )
              )
            )
            (setq p3l (LM:int-ci-ci p1p r1 p2p r2))
            (if (not (LM:Clockwise-p (caar 3dfplp) (cadar 3dfplp) (caddar 3dfplp)))
              (mapcar 'set (list 'p1p 'p2p) (list p2p p1p))
            )
            (if (not (LM:Clockwise-p (car p3l) p2p p1p)) (setq p3p (car p3l)) (setq p3p (cadr p3l)))
            (setq n3dfplp (list p3p p2p p1p))
            (setq ptdptlp (list (list p3p (distance p3p p2p) p2p) (list p2p (distance p2p p1p) p1p) (list p1p (distance p1p p3p) p3p)))
            (setq ptdptlpp (cons ptdptlp ptdptlpp))
            (setq 3dfplp (cons n3dfplp 3dfplp))
          )
        )
      )
      (foreach 3df 3dfplp
        (entmake (list '(0 . "3DFACE") (cons 10 (car 3df)) (cons 11 (car 3df)) (cons 12 (cadr 3df)) (cons 13 (caddr 3df))))
      )
    )
    (prompt "\nEmpty sel.set... Retry routine again with some 3DFACE entities selected...")
  )
  (*error* nil)
)

[marko_ribar]

It doesn't allow me to edit post... Small mistake - change line with (while ... )

      (setvar 'osmode 512)
      (setq p (getpoint "\nPick edge from lattice contours you want me to align to X axis vector of WCS (important - first or last RIGHT BRANCH OF 3DFACE OF LINEAR LATTICE)..."))
      (while (and (not (setq es (nentselp p))) (if es (/= (cdr (assoc 0 (entget (car es)))) "3DFACE") t))

Change to this :

      (setvar 'osmode 512)
      (setq p (getpoint "\nPick edge from lattice contours you want me to align to X axis vector of WCS (important - first or last RIGHT BRANCH OF 3DFACE OF LINEAR LATTICE)..."))
      (while (or (not (setq es (nentselp p))) (if (and es (/= (cdr (assoc 0 (entget (car es)))) "3DFACE")) t))

Regards, M.R.

[carlos_m_gil_p]

Hello Brother how are you.

Thanks for your help.

The function works best every day.

But today I found a mistake.

Attach the file. The red 3DFaces.

[marko_ribar · Accepted solution]

Thanks for testing... I've updated - I hope now it's final... Please if you see something else, inform me...

(defun c:xxx ( / *error* LM:int-ci-ci LM:Clockwise-p commondst unique _vl-position unit acos angle3d *tol* osm f ss p es ip espl esdl esal 3dfpl 3dfplr 3dfdl 3dfdlr 3dfal 3dfalr tmp tmp3dfdlr tmp3dfdlrtmp k n nl ipp ptdptl1 d1 p1dp2l1 p1 p2 p3 ptdptll p1dl r1 r2 esplp 3dfplp p1p p2p p3l p3p n3dfplp ptdptlp ptdptlpp 3dfplp n3dfpl n3dfdl n3dfal ptdptl d p1dp2l p1dp2lp p1pdl )

  (defun *error* ( m )
    (if osm (setvar 'osmode osm))
    (if f (command "_.UCS" "_P"))
    (if m (prompt m))
    (princ)
  )

  ;; 2-Circle Intersection (trans version)  -  Lee Mac
  ;; Returns the point(s) of intersection between two circles
  ;; with centres c1,c2 and radii r1,r2

  (defun LM:int-ci-ci ( c1 r1 c2 r2 / *n* *d1* *x* *z* )
    (if
      (and
        (< (setq *d1* (distance c1 c2)) (+ r1 r2))
        (< (abs (- r1 r2)) *d1*)
      )
      (progn
        (setq *n* (mapcar '- c2 c1))
        (setq c1 (trans c1 0 *n*))
        (setq *z* (/ (- (+ (* r1 r1) (* *d1* *d1*)) (* r2 r2)) (+ *d1* *d1*)))
        (if (equal *z* r1 1e-8)
          (list (trans (list (car c1) (cadr c1) (+ (caddr c1) *z*)) *n* 0))
          (progn
            (setq *x* (sqrt (- (* r1 r1) (* *z* *z*))))
            (list
              (trans (list (- (car c1) *x*) (cadr c1) (+ (caddr c1) *z*)) *n* 0)
              (trans (list (+ (car c1) *x*) (cadr c1) (+ (caddr c1) *z*)) *n* 0)
            )
          )
        )
      )
    )
  )

  ;; Clockwise-p  -  Lee Mac
  ;; Returns T if p1,p2,p3 are clockwise oriented or collinear

  (defun LM:Clockwise-p ( p1 p2 p3 )
    (< (-  (* (- (car  p2) (car  p1)) (- (cadr p3) (cadr p1)))
           (* (- (cadr p2) (cadr p1)) (- (car  p3) (car  p1)))
       )
       1e-8
    )
  )

  (defun commondst ( l1 l2 / *tol* r ) ;; l1 = ((p11 d1 p21) (p12 d2 p22) (p13 d3 p23)) ; l2 = ((p11 d1 p21) (p12 d2 p22) (p13 d3 p23))
    (or *tol* (setq *tol* 1e-6))
    (foreach e l1
      (if (vl-member-if '(lambda ( x ) (or (equal e x *tol*) (equal e (reverse x) *tol*))) l2)
        (setq r e)
      )
    )
    (cadr r)
  )

  (defun unique ( l / *tol* )
    (or *tol* (setq *tol* 1e-6))
    (if l (cons (car l) (unique (vl-remove-if '(lambda ( x ) (equal x (car l) *tol*)) (cdr l)))))
  )

  (defun _vl-position ( e l *z* / *tol* ) ;; *z* must be specified as nil ;;
    (or *tol* (setq *tol* 1e-6))
    (if (null *z*)
      (setq *z* 0)
    )
    (if (not (equal e (car l) *tol*))
      (progn
        (setq *z* (1+ *z*))
        (if (cdr l)
          (_vl-position e (cdr l) *z*)
          (setq *z* nil)
        )
      )
      *z*
    )
  )

  (defun unit ( v )
    (mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)
  )

  (defun acos ( x )
    (cond
      ( (equal x 1.0 1e-8)
        0.0
      )
      ( (equal x -1.0 1e-8)
        pi
      )
      ( (equal x 0.0 1e-8)
        (/ pi 2.0)
      )
      ( (equal x -0.0 1e-8)
        (* 3.0 (/ pi 2.0))
      )
      ( t
        (atan (/ (sqrt (- 1.0 (* x x))) x))
      )
    )
  )

  (defun angle3d ( p1 por p2 / vec1 vec2 dd ang )
    (setq vec1 (unit (mapcar '- p1 por))
          vec2 (unit (mapcar '- p2 por))
          dd (distance vec1 vec2)
          ang (acos (- 1.0 (/ (expt dd 2) 2.0)))
    )
    (if (minusp ang) (+ ang pi) ang)
  )

  (setq *tol* 1e-6)
  (setq osm (getvar 'osmode))
  (if (eq (getvar 'worlducs) 0)
    (progn
      (command "_.UCS" "_W")
      (setq f t)
    )
  )
  (prompt "\nSelect TRIANGULAR 3D FACES OF LINEAR LATTICE in 3D space to unfold them to the ground level 0.0...")
  (setq ss (ssget '((0 . "3DFACE"))))
  (if ss
    (progn
      (setvar 'osmode 512)
      (setq p (getpoint "\nPick edge from lattice contours you want me to align to X axis vector of WCS (important - first or last RIGHT BRANCH OF 3DFACE OF LINEAR LATTICE)..."))
      (while (or (not (setq es (nentselp p))) (if (and es (/= (cdr (assoc 0 (entget (car es)))) "3DFACE")) t))
        (prompt "\nMissed point pick or point specification or picked point belong to entity other than 3DFACE... Try again...")
        (setq p (getpoint "\nPick edge from lattice contours you want me to align to X axis vector of WCS (important - first or last RIGHT BRANCH OF 3DFACE OF LINEAR LATTICE)..."))
      )
      (if (and (= (sslength (ssget "_C" p p '((0 . "3DFACE")))) 2) (not (ssmemb (car es) ss)))
        (setq es (list (ssname (ssdel (car es) (ssget "_P")) 0)))
      )
      (setq ip (getpoint "\nPick or specify insertion point in WCS plane : "))
      (while (not (equal (caddr ip) 0.0 *tol*))
        (prompt "\nPicked or specified insertion point not in WCS... Please retry specification of insertion point...")
        (setq ip (getpoint "\nPick or specify insertion point in WCS plane : "))
      )
      (setq espl (unique (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (_vl-position (car x) '(10 11 12 13) nil)) (entget (car es))))))
      (if (LM:Clockwise-p (car espl) (cadr espl) (caddr espl))
        (setq espl (reverse espl))
      )
      (setq k -1)
      (while (not (equal (distance (nth (if (= (setq k (1+ k)) 3) (setq k 0) k) espl) (nth (if (= (1+ k) 3) 0 (1+ k)) espl)) (+ (distance (nth k espl) p) (distance p (nth (if (= (1+ k) 3) 0 (1+ k)) espl))) *tol*)))
      (setq espl (list (nth k espl) (nth (if (= (setq k (1+ k)) 3) (setq k 0) k) espl) (nth (if (= (setq k (1+ k)) 3) (setq k 0) k) espl)))
      (setq esdl (mapcar '(lambda ( a b ) (distance a b)) espl (append (cdr espl) (list (car espl)))))
      (setq esal (mapcar '(lambda ( c a b ) (if (and (not (equal c a *tol*)) (not (equal a b *tol*))) (angle3d c a b) 0.0)) (append (list (last espl)) (reverse (cdr (reverse espl)))) espl (append (cdr espl) (list (car espl)))))
      (setq 3dfpl (mapcar '(lambda ( x ) (unique (mapcar 'cdr (vl-remove-if-not '(lambda ( y ) (_vl-position (car y) '(10 11 12 13) nil)) (entget x))))) (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
      (setq 3dfplr (vl-remove-if '(lambda ( x ) (and (_vl-position (car espl) x nil) (_vl-position (cadr espl) x nil) (_vl-position (caddr espl) x nil))) 3dfpl))
      (setq 3dfdl (mapcar '(lambda ( x ) (mapcar '(lambda ( a b ) (distance a b)) x (append (cdr x) (list (car x))))) 3dfpl))
      (setq 3dfdlr (mapcar '(lambda ( x ) (mapcar '(lambda ( a b ) (distance a b)) x (append (cdr x) (list (car x))))) 3dfplr))
      (setq 3dfal (mapcar '(lambda ( x ) (mapcar '(lambda ( c a b ) (if (and (not (equal c a *tol*)) (not (equal a b *tol*))) (angle3d c a b) 0.0)) (append (list (last x)) (reverse (cdr (reverse x)))) x (append (cdr x) (list (car x))))) 3dfpl))
      (setq 3dfalr (mapcar '(lambda ( x ) (mapcar '(lambda ( c a b ) (if (and (not (equal c a *tol*)) (not (equal a b *tol*))) (angle3d c a b) 0.0)) (append (list (last x)) (reverse (cdr (reverse x)))) x (append (cdr x) (list (car x))))) 3dfplr))
      (setq ptdptl1 (mapcar '(lambda ( p1 d p2 ) (list p1 d p2)) espl esdl (append (cdr espl) (list (car espl)))))
      (setq tmp ptdptl1)
      (setq tmp3dfdlr (mapcar '(lambda ( x y ) (mapcar '(lambda ( p1 d p2 ) (list p1 d p2)) x y (append (cdr x) (list (car x))))) 3dfplr 3dfdlr))
      (setq tmp3dfdlrtmp tmp3dfdlr)
      (setq k (length tmp3dfdlr))
      (while (and (car tmp3dfdlr) (>= (setq k (1- k)) 0))
        (foreach tmpdl tmp3dfdlr
          (if (and (vl-some '(lambda ( x ) (or (_vl-position x tmp nil) (_vl-position (reverse x) tmp nil))) tmpdl) (not (_vl-position (_vl-position tmpdl tmp3dfdlrtmp nil) nl nil)))
            (setq n (_vl-position tmpdl tmp3dfdlrtmp nil) nl (cons n nl) tmp3dfdlr (vl-remove tmpdl tmp3dfdlr) tmp tmpdl)
          )
        )
      )
      (setq nl (reverse nl))
      (setq ipp ip)
      (if (vl-catch-all-error-p (setq d1 (vl-catch-all-apply 'commondst (list ptdptl1 (vl-catch-all-apply 'nth (list (car nl) tmp3dfdlrtmp))))))
        (setq d1 (nth 1 esdl))
      )
      (setq p1dp2l1 (car (vl-member-if '(lambda ( x ) (equal (cadr x) d1 *tol*)) ptdptl1)))
      (setq p1 (car p1dp2l1) p2 (caddr p1dp2l1) p3 (car (vl-remove p1 (vl-remove p2 espl))))
      (setq ptdptll (mapcar '(lambda ( x y ) (mapcar '(lambda ( p1 d p2 ) (list p1 d p2)) x y (append (cdr x) (list (car x))))) 3dfpl 3dfdl))
      (setq p1dl (unique (mapcar 'cadr (vl-remove-if-not '(lambda ( x ) (or (equal (car x) p1 *tol*) (equal (caddr x) p1 *tol*))) (apply 'append ptdptll)))))
      (setq r1 (cadar (vl-member-if '(lambda ( x ) (or (equal (list (car x) (caddr x)) (list p1 p3) *tol*) (equal (list (car x) (caddr x)) (list p3 p1) *tol*))) ptdptl1)))
      (setq r2 (cadar (vl-member-if '(lambda ( x ) (or (equal (list (car x) (caddr x)) (list p2 p3) *tol*) (equal (list (car x) (caddr x)) (list p3 p2) *tol*))) ptdptl1)))
      (if (not (vl-some '(lambda ( x ) (equal x r1 *tol*)) p1dl))
        (mapcar 'set (list 'p1 'p2) (list p2 p1))
      )
      (if (LM:Clockwise-p p3 p1 p2)
        (progn
          (mapcar 'set (list 'p1 'p2) (list p2 p1))
          (mapcar 'set (list 'r1 'r2) (list r2 r1))
        )
      )
      (setq esal (list (angle3d p2 p3 p1) (angle3d p3 p1 p2) (angle3d p1 p2 p3)))
      (setq esdl (list (distance p3 p1) d1 (distance p2 p3)))
      (setq esplp (list ip (setq ip (polar ip 0.0 (distance p3 p1))) (setq ip (polar ip (- pi (nth 1 esal)) d1))))
      (setq 3dfplp (cons esplp 3dfplp))
      ;;(entmake (list '(0 . "3DFACE") (cons 10 (car esplp)) (cons 11 (car esplp)) (cons 12 (cadr esplp)) (cons 13 (caddr esplp))))
      (setq p1p (cadr esplp) p2p (caddr esplp))
      (if (not (vl-catch-all-error-p (vl-catch-all-apply 'nth (list (car nl) 3dfplr))))
        (progn
          (setq p3 (car (vl-remove p1 (vl-remove p2 (nth (car nl) 3dfplr)))))
          (setq ptdptl (mapcar '(lambda ( p1 d p2 ) (list p1 d p2)) (nth (car nl) 3dfplr) (nth (car nl) 3dfdlr) (append (cdr (nth (car nl) 3dfplr)) (list (car (nth (car nl) 3dfplr))))))
          (setq d d1)
          (setq p1dp2l (car (vl-member-if '(lambda ( x ) (equal (cadr x) d *tol*)) ptdptl)))
          (setq r1 (cadar (vl-member-if '(lambda ( x ) (or (equal (list (car x) (caddr x)) (list p1 p3) *tol*) (equal (list (car x) (caddr x)) (list p3 p1) *tol*))) ptdptl)))
          (setq r2 (cadar (vl-member-if '(lambda ( x ) (or (equal (list (car x) (caddr x)) (list p2 p3) *tol*) (equal (list (car x) (caddr x)) (list p3 p2) *tol*))) ptdptl)))
          (setq p3l (LM:int-ci-ci p1p r1 p2p r2))
          (if (not (LM:Clockwise-p (car p3l) p2p p1p)) (setq p3p (car p3l)) (setq p3p (cadr p3l)))
          (setq n3dfplp (list p3p p2p p1p))
          (setq ptdptlp (list (list p3p (distance p3p p2p) p2p) (list p2p (distance p2p p1p) p1p) (list p1p (distance p1p p3p) p3p)))
          (setq ptdptlpp (cons ptdptlp ptdptlpp))
          (setq 3dfplp (cons n3dfplp 3dfplp))
          ;;(entmake (list '(0 . "3DFACE") (cons 10 p3p) (cons 11 p3p) (cons 12 p1p) (cons 13 p2p)))
          (foreach n (vl-remove (car nl) nl)
            (setq n3dfpl (nth n 3dfplr) n3dfdl (nth n 3dfdlr) n3dfal (nth n 3dfalr))
            (setq ptdptl (mapcar '(lambda ( p1 d p2 ) (list p1 d p2)) n3dfpl n3dfdl (append (cdr n3dfpl) (list (car n3dfpl)))))
            (setq d (commondst
                      (mapcar '(lambda ( p1 d p2 ) (list p1 d p2)) (nth (nth (1- (_vl-position n nl nil)) nl) 3dfplr) (nth (nth (1- (_vl-position n nl nil)) nl) 3dfdlr) (append (cdr (nth (nth (1- (_vl-position n nl nil)) nl) 3dfplr)) (list (car (nth (nth (1- (_vl-position n nl nil)) nl) 3dfplr)))))
                      ptdptl
                    )
            )
            (setq p1dp2l (car (vl-member-if '(lambda ( x ) (equal (cadr x) d *tol*)) ptdptl)))
            (setq p1 (car p1dp2l) p2 (caddr p1dp2l) p3 (car (vl-remove p1 (vl-remove p2 n3dfpl))))
            (setq r1 (cadar (vl-member-if '(lambda ( x ) (or (equal (list (car x) (caddr x)) (list p1 p3) *tol*) (equal (list (car x) (caddr x)) (list p3 p1) *tol*))) ptdptl)))
            (setq r2 (cadar (vl-member-if '(lambda ( x ) (or (equal (list (car x) (caddr x)) (list p2 p3) *tol*) (equal (list (car x) (caddr x)) (list p3 p2) *tol*))) ptdptl)))
            (if (LM:Clockwise-p p3 p1 p2)
              (progn
                (mapcar 'set (list 'p1 'p2) (list p2 p1))
                (mapcar 'set (list 'r1 'r2) (list r2 r1))
              )
            )
            (setq p1dl (unique (mapcar 'cadr (vl-remove-if-not '(lambda ( x ) (or (equal (car x) p1 *tol*) (equal (caddr x) p1 *tol*))) (apply 'append ptdptll)))))
            (setq p1dp2lp (car (vl-member-if '(lambda ( x ) (equal (cadr x) d *tol*)) ptdptlp)))
            (setq p1p (car p1dp2lp) p2p (caddr p1dp2lp))
            (if ptdptlpp
              (progn
                (setq p1pdl (unique (mapcar 'cadr (vl-remove-if-not '(lambda ( x ) (or (equal (car x) p1p *tol*) (equal (caddr x) p1p *tol*))) (apply 'append ptdptlpp)))))
                (foreach d p1dl
                  (setq p1pdl (vl-remove-if '(lambda ( x ) (equal x d *tol*)) p1pdl))
                )
                (if p1pdl
                  (mapcar 'set (list 'p1p 'p2p) (list p2p p1p))
                )
              )
            )
            (if (and (LM:Clockwise-p p3 p1 p2) (not (LM:Clockwise-p (caar 3dfplp) (cadar 3dfplp) (caddar 3dfplp))))
              (mapcar 'set (list 'p1p 'p2p) (list p2p p1p))
            )
            (setq p3l (LM:int-ci-ci p1p r1 p2p r2))
            (if (and (LM:Clockwise-p p3 p1 p2) (not (LM:Clockwise-p (car p3l) p2p p1p))) (setq p3p (car p3l)) (setq p3p (cadr p3l)))
            (setq n3dfplp (list p3p p2p p1p))
            (setq ptdptlp (list (list p3p (distance p3p p2p) p2p) (list p2p (distance p2p p1p) p1p) (list p1p (distance p1p p3p) p3p)))
            (setq ptdptlpp (cons ptdptlp ptdptlpp))
            (setq 3dfplp (cons n3dfplp 3dfplp))
            ;;(entmake (list '(0 . "3DFACE") (cons 10 p3p) (cons 11 p3p) (cons 12 p1p) (cons 13 p2p)))
          )
        )
      )
      (foreach 3df 3dfplp
        (entmake (list '(0 . "3DFACE") (cons 10 (car 3df)) (cons 11 (car 3df)) (cons 12 (cadr 3df)) (cons 13 (caddr 3df))))
      )
    )
    (prompt "\nEmpty sel.set... Retry routine again with some 3DFACE entities selected...")
  )
  (*error* nil)
)

All the best and to you gringo...

M.R.

[carlos_m_gil_p]

Hello Brother how are you.

It works fine.

Keep trying and anything you notice.
I hope that in future we can improve breaches.

Thanks for your help.
Thanks for your time.
A greeting.

[marko_ribar]

Here is working version and for branches... I've debugged it so it should work in any situation... If something's wrong now reply...

;;;                                                                                            ;;;
;;;                    by Nolo en Hispacad                                                     ;;;
;;;                                                                                            ;;;

(defun c:xxx1 (/    _vl-position    massoclst       deldu   sentido solod
                    3cdp            ent-3dcara      intercc unique  ; funciones
                    ;; variables
                    ss      se      ssep    ssnew   ssmaxl  x       name
                    listap  lp      ld      d       d1      d2      p
                    p1      p2      plano   names   siguiente       pro
                    pro2    siguientes      old     3dfl    3dfdl   ptdptl
                    ptdl    ptdln   ptdlnn  ptdptlp ptdlp   ptdlpa  p3p
                    p1p     p2p
              )
  
  (defun unique ( l )
    (or *tol* (setq *tol* 1e-10))
    (if l (cons (car l) (unique (vl-remove-if '(lambda ( x ) (equal x (car l) *tol*)) (cdr l)))))
  )
  
  (defun _vl-position ( e l *z* / *tol* ) ;; *z* must be specified as nil ;;
    (or *tol* (setq *tol* 1e-10))
    (if (null *z*)
      (setq *z* 0)
    )
    (if (not (equal e (car l) *tol*))
      (progn
        (setq *z* (1+ *z*))
        (if (cdr l)
          (_vl-position e (cdr l) *z*)
          (setq *z* nil)
        )
      )
      *z*
    )
  )
  
  (defun massoclst ( key lst )
    (if (assoc key lst) (cons (assoc key lst) (massoclst key (cdr (member (assoc key lst) lst)))))
  )
  
  ;; funciones utilizadas
  ;; eliminar duplicados en lista
  (defun deldu (lista / num)
    ;; By Nolo
    (vl-remove
      nil
      (mapcar '(lambda (a / n)
        (if (not (member (setq n (vl-position a lista)) num))
          (progn (setq num (append num (list n))) a)
            nil
          )
        )
        lista
      )
    )
  )
;;;; devuelve -1 0 1 segun alineación de los puntos a b c Tony Tanzillo
  (defun sentido (a b c / r)		; de Tony Tanzillo modificada por Nolo
    (setq r (- (* (- (car b) (car a)) (- (cadr c) (cadr a)))
              (* (- (cadr b) (cadr a)) (- (car c) (car a)))
	    )
    )
    (if	(equal r 0.0 0.00001)
      0
      (setq r (fix (/ r (abs r))))
    )
  )
;;; sacar solo datos duplicados en lista
  (defun solod (lista / res)
    ;; By NOLO
    (foreach a lista
      (if (and (member a (cdr (member a lista))) (not (member a res)))
        (setq res (cons a res))
      )
    )
    res
  )					; centro de varios puntos en 3d
  (defun 3cdp (pl / n)			; by ymg
    (setq n (length pl))
    (mapcar '(lambda (a) (/ a n)) (apply 'mapcar (cons '+ pl)))
  )
;;;; dibujar cara 3d
  (defun ent-3dcara (vertices)
    ;; TOGORES
    (entmake (list '(0 . "3DFACE")
            '(100 . "AcDbEntity")
            '(100 . "AcDbFace")
            (cons 10 (nth 0 vertices))
            (cons 11 (nth 1 vertices))
            (cons 12 (nth 2 vertices))
            (if (nth 3 vertices)
              (cons 13 (nth 3 vertices))
              (cons 13 (nth 2 vertices))
            )
          )
    )
  )
  ;;intersección de dos circulos con un punto de referencia pref para validar una solución
  (defun intercc (c1 r1 c2 r2 pref / salfa calfa d an p3)
    ;; TOGORES modificada por NOLO
    (setq d	(distance c1 c2)
        an	(angle c1 c2)
        calfa	(/ (- (+ (expt r1 2) (expt d 2)) (expt r2 2)) 2 r1 d)
        salfa	(sqrt (abs (- 1 (expt calfa 2))))
;;; problema raiz cuadrada en algunos valores negativos ???
;;; Problem, square root, in some negative values ???
    )
    (setq p3 (polar c1 (+ an (atan salfa calfa)) r1))
    (if	(and pref (= (sentido c1 c2 p3) (sentido c1 c2 pref)))
      (setq p3 (polar c1 (- an (atan salfa calfa)) r1))
      p3
    )
  )
;;;;;;;;;;;;;;;;; programa ;;;;;;;;;;;;;;;;;;
  ;; selección por ventana o crosing
  (princ "\nSeleccionar conjunto de triangulaciones 3d : ")
  (setq	ss   (ssget '((0 . "3DFACE")))
	;; conjunto selección
      sse  (vl-remove-if-not
            '(lambda (a) (= (type a) 'ename))
            (apply 'append (ssnamex ss))
           )
	;; lista con entidades
      ssep (mapcar
            '(lambda	(x / e)
              (setq e (entget x))
              (cons
                (cdr (assoc 5 e))
                  ;; lista con hadled de entidad y puntos
                (deldu
                (mapcar 'cdr
                  (vl-remove-if-not
                   '(lambda (a) (member (car a) '(10 11 12 13)))
                    e
                  )
                )
              )
            )
          )
          sse
        )
  )
  ;; buscamos colindancias y las guardamo en una nueva lista
  ;; lista con handled entidad, perímetro y colindantes
  (setq
    ssnew (mapcar
          '(lambda (x / ladosx 2lados contiguos i)
          (list
          (car x)
;;; nombre entidad
          (apply
            '+
            (mapcar 'distance
              (cdr x)
                (append (cdr (cdr x)) (list (car (cdr x))))
            )
          )
          ;; perímetrto
          (setq ladosx	 (mapcar
                    '(lambda (a)
                        ;; por cada 10 11 12 13 de x
                        (mapcar
                          'car
                          (vl-remove-if-not
                            '(lambda (b)
                              ;; los que tiene un punto próximo
                              (vl-remove
                                nil
                                  (mapcar '(lambda	(c)
                                    (equal (distance c a)
                                      0.
                                      0.0001
                                    )
                                  )
                                  (cdr b)
                                )
                              )
                            )
                            (vl-remove x ssep)
                          )
                        )
                      )
                    (cdr x)
                )
                2lados	 (solod (apply 'append ladosx))
                ;; recoger solo cuando hay dos puntos sobre la entidad
                contiguos ;; identificar con un número las coordendas para no guardad los puntos enteros
                  (mapcar
                    '(lambda (a / i)
                        (setq i -1)
                        (cons a
                          (vl-remove
                            nil
                            (mapcar '(lambda (b)
                              (setq i (1+ i))
                              (if (member a b)
                                i
                              )
                                )
                                ladosx
                            )
                          )
                        )
                    )
                    2lados
                  )
          )
        )
      )
      ssep
    )
  )
  ;; ordenar por número de lados y perímetro
  (setq	ssmaxl (car
;;; la entidad de mayor número de lados y perímetro
              (setq ssnew
                (vl-sort
                  ssnew
                  '(lambda (a b)
                      ;; lista ordenada
                      (if (eq (length (last a)) (length (last b)))
                        (> (cadr a) (cadr b))
                        (> (length (last a)) (length (last b)))
                      )
                    )
                )
              )
            )
  )

  (setq 3dfl (mapcar 'cdr ssep))
  (setq 3dfdl (mapcar '(lambda (x) (mapcar '(lambda (p1 p2) (list p1 (distance p1 p2) p2)) x (append (cdr x) (list (car x))) )) 3dfl))
  (setq ptdptl (apply 'append 3dfdl))
  (setq ptdl (append (mapcar '(lambda (x) (list (car x) (cadr x))) ptdptl) (mapcar '(lambda (x) (list (caddr x) (cadr x))) ptdptl)))
  (foreach ptd ptdl
    (setq ptdln (cons (massoclst (car ptd) ptdl) ptdln))
  )
  (foreach ptd ptdln
    (if (not (member (caar ptd) (mapcar 'car ptdlnn)))
      (setq ptdlnn (cons (cons (caar ptd) (apply 'append (mapcar 'cdr ptd))) ptdlnn))
    )
  )

  ;; crear la primera cara aplanada desde ssmaxl
  (setq	name   (car ssmaxl)
      ;; nombre primera entidad a dibujar
      x      (assoc name ssep)
      ;; datos de la entidad
      listap (mapcar 'set '(p1 p2 p3) (cdr x))
      ld     (mapcar 'set
                '(d d1 d2)
                (mapcar 'distance (list p1 p2 p3) (list p2 p3 p1))
            )
  )
  (redraw (handent name) 3)
  ;; entrada de datos 
  (setq	p1  (getpoint "\nDonde pongo la primera entidad ? : ")
      ang (angle p1 (getpoint "\nGiro para crear entidad : " p1))
      p2  (polar p1 ang d)
      p3  (intercc p1 d2 p2 d1 nil)
  )
  ;; dibujar la primera
  (ent-3dcara (setq plano (list p1 p2 p3)))
  
  (setq ptdptlp (mapcar '(lambda (p1 p2) (list p1 (distance p1 p2) p2)) plano (append (cdr plano) (list (car plano)))))
  (setq ptdlp (unique (append (mapcar '(lambda (x) (list (car x) (cadr x))) ptdptlp) (mapcar '(lambda (x) (list (caddr x) (cadr x))) ptdptlp))))
  
  (redraw (handent name) 4)
  ;; inicializarlistas para iterar
  (setq	ya	   (list (list name
                    ;; lista con nombre endidad 3d
                    (cdr (assoc 5 (entget (entlast))))
                    ;; nombre 2d
                    plano
                    ;; puntos dibujados en 2d
              )
            )
      names	   (mapcar 'car ssep)
      ;; lista solos con nombres
      siguientes '()
;;; lista vacía para agrupar en orden
  )
;;;;;; bucle principal ;;;;;
  (while (setq names (vl-remove name names))
    ;; mientras me quedan nombres guardados
    (princ (strcat "\nBase para iterar " name))
    ;; nombre entidad dxf 5
    ;; buscamos colindantes
    (setq x	 (last (assoc name ssnew))
        ;; nombre y datos entidades colindantes
        plano	 (last (assoc name ya))
        ;; puntos de la entidad plana guardados en ya
        origen (cdr (assoc name ssep))
        ;; puntos en el espacio de la entidad base
        pref	 (3cdp plano)
        ;; referencia para dibujar p3
    )
    (foreach a x
      (princ (strcat "\nComprobando " (car a)))
      (if (member (car a) (mapcar 'car ya))
      ;; si ya esta dibujada
      (princ "\nDesarrollo ya dibujado ...")
      (progn
        (setq	lp     (cdr (assoc (car a) ssep))
          ;; sacamos tres puntos 3d del colindante
          listap (mapcar 'set
                    '(p1 p2)
                    ;; puntos de la linea colindantes
                    (mapcar '(lambda (b) (nth b origen)) (cdr a))
                )
          lp     (vl-remove-if '(lambda (b) (member b listap)) lp)
          p3     (car lp)
          ;; tercer punto
          ;; controlamos con un flag el sentido de giro
          ;|
          flag   (sentido	(setq pro (3cdp listap)
                        pro (list (car pro) (cadr pro))
                  )
                  (setq
                    pro2 (inters
                      pro
                      (polar pro (+ (angle p1 p2) (/ pi 2)) 1)
;;; ojo aqui
                      (setq p (list (car p3) (cadr p3)))
                      (polar p (angle p1 p2) 1)
                      nil
                        )
                )
                  p
                )
            |;
          ld     (mapcar 'set
                    '(d d1 d2)
                    (mapcar 'distance (list p1 p1 p2) (list p2 p3 p3))
                )
        )
;;; en teoría debería coincidir la seguencia de puntos en el espacio y en el plano
        ;; pero pudiera ser que no, así que lo sacamos igualando distancias d	
        (if (setq lp plano
              lp (mapcar '(lambda (a b) (cons (distance a b) (list a b)))
                    lp
                    (append (cdr lp) (list (car lp)))
                )
              lp (vl-remove-if-not
              '(lambda (a) (equal (car a) d 0.00001))
              lp
                )
            )
          (setq lp (car lp)
            p1p (cadr lp)
            p2p (last lp)
          )
          ;; asignamos p1 y p2 por distancia d
          ;|
          (setq p1 (nth (cadr a) plano)
            p2 (nth (last a) plano)
          )
          ;; asignamos p1 y p2 por secuencia en x
           |;
        )
        (if (null ptdlpa) (setq ptdlpa (unique ptdlp)))
        (cond 
          ( (_vl-position d1 (assoc p1 ptdlnn) nil)
            (if (vl-every '(lambda (x) (_vl-position x (assoc p1 ptdlnn) nil)) (apply 'append (mapcar 'cdr (massoclst p1p ptdlpa))))
              ;; calculas el punto del plano
              (setq	p3p (intercc p1p d1 p2p d2 pref)
              listap (list p1p p2p p3p)
              )
              (setq p3p (intercc p2p d1 p1p d2 pref)
              listap (list p1p p2p p3p)
              )
            )
          )
	  ;||;
          ( (_vl-position d2 (assoc p1 ptdlnn) nil)
            (if (vl-every '(lambda (x) (_vl-position x (assoc p1 ptdlnn) nil)) (apply 'append (mapcar 'cdr (massoclst p1p ptdlpa))))
              ;; calculas el punto del plano
              (setq	p3p (intercc p1p d2 p2p d1 pref)
              listap (list p1p p2p p3p)
              )
              (setq p3p (intercc p2p d2 p1p d1 pref)
              listap (list p1p p2p p3p)
              )
            )
          )
          ;||;
	  ( t
            (if (vl-every '(lambda (x) (_vl-position x (assoc p1 ptdlnn) nil)) (apply 'append (mapcar 'cdr (massoclst p1p ptdlpa))))
              ;; calculas el punto del plano
              (setq	p3p (intercc p1p d1 p2p d2 pref)
              listap (list p1p p2p p3p)
              )
              (setq p3p (intercc p2p d1 p1p d2 pref)
              listap (list p1p p2p p3p)
              )
            )
	  )
        )
        ;|
        ;; corregimos con el flag por si se hubiera girado por la raiz cuadrada
        (if (/= flag
            (sentido (setq pro (3cdp (list p1 p2)))
                (setq pro2
                    (inters pro
                        (polar pro (+ (angle p1 p2) (/ pi 2)) 1)
                        p3
                        (polar p3 (angle p1 p2) 1)
                        nil
                    )
                )
                p3
            )
            )
          (setq p3	 (intercc p1 d2 p2 d1 pref)
            listap (list p1 p2 p3)
          )
        )
         |;
        (setq ptdptlp (mapcar '(lambda (p1 p2) (list p1 (distance p1 p2) p2)) listap (append (cdr listap) (list (car listap)))))
        (setq ptdlpn (unique (append (mapcar '(lambda (x) (list (car x) (cadr x))) ptdptlp) (mapcar '(lambda (x) (list (caddr x) (cadr x))) ptdptlp))))
        (setq ptdlpa (unique (append ptdlpn ptdlpa))) 

        (if
          (equal ;; comprobación
            (apply '+ (mapcar 'distance listap (list p2p p3p p1p)))
            (cadr (assoc (car a) ssnew))
            0.0001
          )
          (print (list (setq color "BYLAYER") "Suma perímetros OK"))
          (print (list (setq color "2") "Suma perímetros MAL"))
        )
        ;; centros alineados con p3
        ;; dibujamos
        (setvar 'cecolor color)
        (ent-3dcara (setq listap (list p1p p2p p3p)))
        (setvar 'cecolor "BYLAYER")
        ;; añadimo los ya dibujados a lista ya
        (setq	ya (cons (list (car a)
                    (cdr (assoc 5 (entget (entlast))))
                    listap
              )
              ya
            )
        )
        ;; añadimos las entidades obtenidas de la lista x en siguientes
        (if (not (member (car a) siguientes))
          (setq siguientes (cons (car a) siguientes))
        )
      ); fin progn
      ); fin if
    ); fin foreach
    
    ;; hacemos name igual al primer siguiente
    (setq name	     (car siguientes)
	  siguientes (cdr siguientes)
    )
;;;; (getstring "\nContinuar : ") ;; para comprobaciones
  )
  ;; fin while
  (princ "\nTerminado ...")
  (princ)
)
;;fin defun

Regards, M.R.

[carlos_m_gil_p]

Hello Brother how are you.

Lisp is perfect, it works fine.

I appreciate it a lot.

I was going to ask another question.

There is the possibility that the new 3DFaces are drawn below the originals.
Not have to specify the location and angle where you will place.

If you can clear this.
It would be much easier and better.

1. Select the original 3DFaces
2. To enter
3. draw automatically.

attached DWG

[marko_ribar]

Yes it's possible, but not just exactly as you did in your posted DWG, but as closest as possible, just find sintagmas in my last posted code and replace with this lines :

  (redraw (handent name) 3)
  ;|
  ;; entrada de datos 
  (setq	p1  (getpoint "\nDonde pongo la primera entidad ? : ")
      ang (angle p1 (getpoint "\nGiro para crear entidad : " p1))
      p2  (polar p1 ang d)
      p3  (intercc p1 d2 p2 d1 nil)
  )
  |;
  (setq p1 (list (car p1) (cadr p1)))
  (setq p2 (polar p1 (angle p1 p2) d))
  (setq p3 (intercc p1 d2 p2 d1 nil))
  ;; dibujar la primera
  (ent-3dcara (setq plano (list p1 p2 p3)))

HTH, M.R.

[carlos_m_gil_p]

Hello Brother.

This perfect.
No need to do anything more.

Thanks of heart.

I'm to order.

[marko_ribar]

I've improved it more - now should work as good and with quad 3dfaces... Someone posted similar request at other site and insisted on 3dface entities as they are - with 4 points (equal or not)... Now I think this topic is closed...

;;;                                                                                            ;;;
;;;                    by Nolo en Hispacad                                                     ;;;
;;;                                                                                            ;;;

(defun c:xxx1 (/    _vl-position    massoclst       deldu   sentido solod
                    3cdp            ent-3dcara      intercc unique  ; funciones
                    ;; variables
                    ss      se      ssep    ssnew   ssmaxl  x       name
                    listap  lp      ld      d       d1      d2      p
                    p1      p2      plano   names   siguiente       pro
                    pro2    siguientes      old     3dfl    3dfdl   ptdptl
                    ptdl    ptdln   ptdlnn  ptdptlp ptdlp   ptdlpa  p3p
                    p1p     p2p     *tol*   s       i       3df     3dfrl
	            3df1    3df2    pt1     pt2     pt3     pt4     nnames
	            nnamesp 3dfrlp  pt11    pt12    pt13    pt14    pt21
	            pt22    pt23    pt24    d1l     d2l     ddl
              )
  
  (defun unique ( l )
    (or *tol* (setq *tol* 1e-10))
    (if l (cons (car l) (unique (vl-remove-if '(lambda ( x ) (equal x (car l) *tol*)) (cdr l)))))
  )
  
  (defun _vl-position ( e l *z* / *tol* ) ;; *z* must be specified as nil ;;
    (or *tol* (setq *tol* 1e-10))
    (if (null *z*)
      (setq *z* 0)
    )
    (if (not (equal e (car l) *tol*))
      (progn
        (setq *z* (1+ *z*))
        (if (cdr l)
          (_vl-position e (cdr l) *z*)
          (setq *z* nil)
        )
      )
      *z*
    )
  )
  
  (defun massoclst ( key lst )
    (if (assoc key lst) (cons (assoc key lst) (massoclst key (cdr (member (assoc key lst) lst)))))
  )
  
  ;; funciones utilizadas
  ;; eliminar duplicados en lista
  (defun deldu (lista / num)
    ;; By Nolo
    (vl-remove
      nil
      (mapcar '(lambda (a / n)
        (if (not (member (setq n (vl-position a lista)) num))
          (progn (setq num (append num (list n))) a)
            nil
          )
        )
        lista
      )
    )
  )
;;;; devuelve -1 0 1 segun alineación de los puntos a b c Tony Tanzillo
  (defun sentido (a b c / r)		; de Tony Tanzillo modificada por Nolo
    (setq r (- (* (- (car b) (car a)) (- (cadr c) (cadr a)))
              (* (- (cadr b) (cadr a)) (- (car c) (car a)))
	    )
    )
    (if	(equal r 0.0 0.00001)
      0
      (setq r (fix (/ r (abs r))))
    )
  )
;;; sacar solo datos duplicados en lista
  (defun solod (lista / res)
    ;; By NOLO
    (foreach a lista
      (if (and (member a (cdr (member a lista))) (not (member a res)))
        (setq res (cons a res))
      )
    )
    res
  )					; centro de varios puntos en 3d
  (defun 3cdp (pl / n)			; by ymg
    (setq n (length pl))
    (mapcar '(lambda (a) (/ a n)) (apply 'mapcar (cons '+ pl)))
  )
;;;; dibujar cara 3d
  (defun ent-3dcara (vertices)
    ;; TOGORES
    (entmake (list '(0 . "3DFACE")
            '(100 . "AcDbEntity")
            '(100 . "AcDbFace")
            (cons 10 (nth 0 vertices))
            (cons 11 (nth 1 vertices))
            (cons 12 (nth 2 vertices))
            (if (nth 3 vertices)
              (cons 13 (nth 3 vertices))
              (cons 13 (nth 2 vertices))
            )
          )
    )
  )
  ;;intersección de dos circulos con un punto de referencia pref para validar una solución
  (defun intercc (c1 r1 c2 r2 pref / salfa calfa d an p3)
    ;; TOGORES modificada por NOLO
    (setq d	(distance c1 c2)
        an	(angle c1 c2)
        calfa	(/ (- (+ (expt r1 2) (expt d 2)) (expt r2 2)) 2 r1 d)
        salfa	(sqrt (abs (- 1 (expt calfa 2))))
;;; problema raiz cuadrada en algunos valores negativos ???
;;; Problem, square root, in some negative values ???
    )
    (setq p3 (polar c1 (+ an (atan salfa calfa)) r1))
    (if	(and pref (= (sentido c1 c2 p3) (sentido c1 c2 pref)))
      (setq p3 (polar c1 (- an (atan salfa calfa)) r1))
      p3
    )
  )
;;;;;;;;;;;;;;;;; programa ;;;;;;;;;;;;;;;;;;
  ;; selección por ventana o crosing
  (setq *tol* 1e-10)
  (princ "\nSelect 3DFACES to unfold...")
  (setq s (ssget '((0 . "3DFACE"))))
  (repeat (setq i (sslength s))
    (setq 3df (ssname s (setq i (1- i))))
    (mapcar 'set '(pt1 pt2 pt3 pt4) (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (vl-position (car x) '(10 11 12 13))) (entget 3df))))
    (if (and (not (equal pt1 pt2 *tol*)) (not (equal pt2 pt3 *tol*)) (not (equal pt3 pt4 *tol*)) (not (equal pt4 pt1 *tol*)))
      (progn
	(setq 3df1 (entmakex (list '(0 . "3DFACE") (cons 10 pt1) (cons 11 pt1) (cons 12 pt2) (cons 13 pt3))))
	(setq 3df2 (entmakex (list '(0 . "3DFACE") (cons 10 pt3) (cons 11 pt3) (cons 12 pt4) (cons 13 pt1))))
	(setq 3dfrl (cons (list (cdr (assoc 5 (entget 3df1))) (cdr (assoc 5 (entget 3df2)))) 3dfrl))
	(ssdel 3df s)
	(ssadd 3df1 s)
	(ssadd 3df2 s)
      )
    )
  )
  (setq ss (ssadd))
  (repeat (setq i (sslength s))
    (ssadd (ssname s (setq i (1- i))) ss)
  )
  (setq
	;; conjunto selección
      sse  (vl-remove-if-not
            '(lambda (a) (= (type a) 'ename))
            (apply 'append (ssnamex ss))
           )
	;; lista con entidades
      ssep (mapcar
            '(lambda	(x / e)
              (setq e (entget x))
              (cons
                (cdr (assoc 5 e))
                  ;; lista con hadled de entidad y puntos
                (deldu
                (mapcar 'cdr
                  (vl-remove-if-not
                   '(lambda (a) (member (car a) '(10 11 12 13)))
                    e
                  )
                )
              )
            )
          )
          sse
        )
  )
  ;; buscamos colindancias y las guardamo en una nueva lista
  ;; lista con handled entidad, perímetro y colindantes
  (setq
    ssnew (mapcar
          '(lambda (x / ladosx 2lados contiguos i)
          (list
          (car x)
;;; nombre entidad
          (apply
            '+
            (mapcar 'distance
              (cdr x)
                (append (cdr (cdr x)) (list (car (cdr x))))
            )
          )
          ;; perímetrto
          (setq ladosx	 (mapcar
                    '(lambda (a)
                        ;; por cada 10 11 12 13 de x
                        (mapcar
                          'car
                          (vl-remove-if-not
                            '(lambda (b)
                              ;; los que tiene un punto próximo
                              (vl-remove
                                nil
                                  (mapcar '(lambda	(c)
                                    (equal (distance c a)
                                      0.
                                      0.0001
                                    )
                                  )
                                  (cdr b)
                                )
                              )
                            )
                            (vl-remove x ssep)
                          )
                        )
                      )
                    (cdr x)
                )
                2lados	 (solod (apply 'append ladosx))
                ;; recoger solo cuando hay dos puntos sobre la entidad
                contiguos ;; identificar con un número las coordendas para no guardad los puntos enteros
                  (mapcar
                    '(lambda (a / i)
                        (setq i -1)
                        (cons a
                          (vl-remove
                            nil
                            (mapcar '(lambda (b)
                              (setq i (1+ i))
                              (if (member a b)
                                i
                              )
                                )
                                ladosx
                            )
                          )
                        )
                    )
                    2lados
                  )
          )
        )
      )
      ssep
    )
  )
  ;; ordenar por número de lados y perímetro
  (setq	ssmaxl (car
;;; la entidad de mayor número de lados y perímetro
              (setq ssnew
                (vl-sort
                  ssnew
                  '(lambda (a b)
                      ;; lista ordenada
                      (if (eq (length (last a)) (length (last b)))
                        (> (cadr a) (cadr b))
                        (> (length (last a)) (length (last b)))
                      )
                    )
                )
              )
            )
  )

  (setq 3dfl (mapcar 'cdr ssep))
  (setq 3dfdl (mapcar '(lambda (x) (mapcar '(lambda (p1 p2) (list p1 (distance p1 p2) p2)) x (append (cdr x) (list (car x))) )) 3dfl))
  (setq ptdptl (apply 'append 3dfdl))
  (setq ptdl (append (mapcar '(lambda (x) (list (car x) (cadr x))) ptdptl) (mapcar '(lambda (x) (list (caddr x) (cadr x))) ptdptl)))
  (foreach ptd ptdl
    (setq ptdln (cons (massoclst (car ptd) ptdl) ptdln))
  )
  (foreach ptd ptdln
    (if (not (member (caar ptd) (mapcar 'car ptdlnn)))
      (setq ptdlnn (cons (cons (caar ptd) (apply 'append (mapcar 'cdr ptd))) ptdlnn))
    )
  )

  ;; crear la primera cara aplanada desde ssmaxl
  (setq	name   (car ssmaxl)
      ;; nombre primera entidad a dibujar
      x      (assoc name ssep)
      ;; datos de la entidad
      listap (mapcar 'set '(p1 p2 p3) (cdr x))
      ld     (mapcar 'set
                '(d d1 d2)
                (mapcar 'distance (list p1 p2 p3) (list p2 p3 p1))
            )
  )
  
  ;|
  ;; entrada de datos 
  (setq	p1  (getpoint "\nDonde pongo la primera entidad ? : ")
      ang (angle p1 (getpoint "\nGiro para crear entidad : " p1))
      p2  (polar p1 ang d)
      p3  (intercc p1 d2 p2 d1 nil)
  )
  |;
  (setq p1 (list (car p1) (cadr p1)))
  (setq p2 (polar p1 (angle p1 p2) d))
  (setq p3 (intercc p1 d2 p2 d1 nil))
  ;; dibujar la primera
  (ent-3dcara (setq plano (list p1 p2 p3)))
  (setq nnamesp (cons (cdr (assoc 5 (entget (entlast)))) nnamesp))
  
  (setq ptdptlp (mapcar '(lambda (p1 p2) (list p1 (distance p1 p2) p2)) plano (append (cdr plano) (list (car plano)))))
  (setq ptdlp (unique (append (mapcar '(lambda (x) (list (car x) (cadr x))) ptdptlp) (mapcar '(lambda (x) (list (caddr x) (cadr x))) ptdptlp))))
  
  ;; inicializarlistas para iterar
  (setq	ya	   (list (list name
                    ;; lista con nombre endidad 3d
                    (cdr (assoc 5 (entget (entlast))))
                    ;; nombre 2d
                    plano
                    ;; puntos dibujados en 2d
              )
            )
      names	   (mapcar 'car ssep)
      ;; lista solos con nombres
      siguientes '()
;;; lista vacía para agrupar en orden
  )
  (setq nnames (cons name nnames))
;;;;;; bucle principal ;;;;;
  (while (setq names (vl-remove name names))
    ;; mientras me quedan nombres guardados
    (princ (strcat "\nBase para iterar " name))
    ;; nombre entidad dxf 5
    ;; buscamos colindantes
    (setq x	 (last (assoc name ssnew))
        ;; nombre y datos entidades colindantes
        plano	 (last (assoc name ya))
        ;; puntos de la entidad plana guardados en ya
        origen (cdr (assoc name ssep))
        ;; puntos en el espacio de la entidad base
        pref	 (3cdp plano)
        ;; referencia para dibujar p3
    )
    (foreach a x
      (princ (strcat "\nComprobando " (car a)))
      (if (member (car a) (mapcar 'car ya))
      ;; si ya esta dibujada
      (princ "\nDesarrollo ya dibujado ...")
      (progn
        (setq	lp     (cdr (assoc (car a) ssep))
          ;; sacamos tres puntos 3d del colindante
          listap (mapcar 'set
                    '(p1 p2)
                    ;; puntos de la linea colindantes
                    (mapcar '(lambda (b) (nth b origen)) (cdr a))
                )
          lp     (vl-remove-if '(lambda (b) (member b listap)) lp)
          p3     (car lp)
          ;; tercer punto
          ;; controlamos con un flag el sentido de giro
          ;|
          flag   (sentido	(setq pro (3cdp listap)
                        pro (list (car pro) (cadr pro))
                  )
                  (setq
                    pro2 (inters
                      pro
                      (polar pro (+ (angle p1 p2) (/ pi 2)) 1)
;;; ojo aqui
                      (setq p (list (car p3) (cadr p3)))
                      (polar p (angle p1 p2) 1)
                      nil
                        )
                )
                  p
                )
            |;
          ld     (mapcar 'set
                    '(d d1 d2)
                    (mapcar 'distance (list p1 p1 p2) (list p2 p3 p3))
                )
        )
;;; en teoría debería coincidir la seguencia de puntos en el espacio y en el plano
        ;; pero pudiera ser que no, así que lo sacamos igualando distancias d	
        (if (setq lp plano
              lp (mapcar '(lambda (a b) (cons (distance a b) (list a b)))
                    lp
                    (append (cdr lp) (list (car lp)))
                )
              lp (vl-remove-if-not
              '(lambda (a) (equal (car a) d 0.00001))
              lp
                )
            )
          (setq lp (car lp)
            p1p (cadr lp)
            p2p (last lp)
          )
          ;; asignamos p1 y p2 por distancia d
          ;|
          (setq p1 (nth (cadr a) plano)
            p2 (nth (last a) plano)
          )
          ;; asignamos p1 y p2 por secuencia en x
           |;
        )
        (if (null ptdlpa) (setq ptdlpa (unique ptdlp)))
        (cond 
          ( (_vl-position d1 (assoc p1 ptdlnn) nil)
            (if (vl-every '(lambda (x) (_vl-position x (assoc p1 ptdlnn) nil)) (apply 'append (mapcar 'cdr (massoclst p1p ptdlpa))))
              ;; calculas el punto del plano
              (setq	p3p (intercc p1p d1 p2p d2 pref)
              listap (list p1p p2p p3p)
              )
              (setq p3p (intercc p2p d1 p1p d2 pref)
              listap (list p1p p2p p3p)
              )
            )
          )
	  ;||;
          ( (_vl-position d2 (assoc p1 ptdlnn) nil)
            (if (vl-every '(lambda (x) (_vl-position x (assoc p1 ptdlnn) nil)) (apply 'append (mapcar 'cdr (massoclst p1p ptdlpa))))
              ;; calculas el punto del plano
              (setq	p3p (intercc p1p d2 p2p d1 pref)
              listap (list p1p p2p p3p)
              )
              (setq p3p (intercc p2p d2 p1p d1 pref)
              listap (list p1p p2p p3p)
              )
            )
          )
          ;||;
	  ( t
            (if (vl-every '(lambda (x) (_vl-position x (assoc p1 ptdlnn) nil)) (apply 'append (mapcar 'cdr (massoclst p1p ptdlpa))))
              ;; calculas el punto del plano
              (setq	p3p (intercc p1p d1 p2p d2 pref)
              listap (list p1p p2p p3p)
              )
              (setq p3p (intercc p2p d1 p1p d2 pref)
              listap (list p1p p2p p3p)
              )
            )
	  )
        )
        ;|
        ;; corregimos con el flag por si se hubiera girado por la raiz cuadrada
        (if (/= flag
            (sentido (setq pro (3cdp (list p1 p2)))
                (setq pro2
                    (inters pro
                        (polar pro (+ (angle p1 p2) (/ pi 2)) 1)
                        p3
                        (polar p3 (angle p1 p2) 1)
                        nil
                    )
                )
                p3
            )
            )
          (setq p3	 (intercc p1 d2 p2 d1 pref)
            listap (list p1 p2 p3)
          )
        )
         |;
        (setq ptdptlp (mapcar '(lambda (p1 p2) (list p1 (distance p1 p2) p2)) listap (append (cdr listap) (list (car listap)))))
        (setq ptdlpn (unique (append (mapcar '(lambda (x) (list (car x) (cadr x))) ptdptlp) (mapcar '(lambda (x) (list (caddr x) (cadr x))) ptdptlp))))
        (setq ptdlpa (unique (append ptdlpn ptdlpa))) 

        (if
          (equal ;; comprobación
            (apply '+ (mapcar 'distance listap (list p2p p3p p1p)))
            (cadr (assoc (car a) ssnew))
            0.0001
          )
          (print (list (setq color "BYLAYER") "Suma perímetros OK"))
          (print (list (setq color "2") "Suma perímetros MAL"))
        )
        ;; centros alineados con p3
        ;; dibujamos
        (setvar 'cecolor color)
        (ent-3dcara (setq listap (list p1p p2p p3p)))
	(setq nnamesp (cons (cdr (assoc 5 (entget (entlast)))) nnamesp))
	(setq nnames (cons (vl-some '(lambda ( x ) (if (vl-every '(lambda ( y ) (_vl-position y x nil)) (list p1 p2 p3)) (car x))) ssep) nnames))
        (setvar 'cecolor "BYLAYER")
        ;; añadimo los ya dibujados a lista ya
        (setq	ya (cons (list (car a)
                    (cdr (assoc 5 (entget (entlast))))
                    listap
              )
              ya
            )
        )
        ;; añadimos las entidades obtenidas de la lista x en siguientes
        (if (not (member (car a) siguientes))
          (setq siguientes (cons (car a) siguientes))
        )
      ); fin progn
      ); fin if
    ); fin foreach
    
    ;; hacemos name igual al primer siguiente
    (setq name	     (car siguientes)
	  siguientes (cdr siguientes)
    )
;;;; (getstring "\nContinuar : ") ;; para comprobaciones
  )
  ;; fin while
  (setq nnames (reverse nnames))
  (setq nnamesp (reverse nnamesp))
  (setq 3dfrlp (mapcar '(lambda ( x ) (list (nth (vl-position (car x) nnames) nnamesp) (nth (vl-position (cadr x) nnames) nnamesp))) 3dfrl))
  (foreach pair 3dfrlp
    (mapcar 'set '(pt11 pt12 pt13 pt14) (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (vl-position (car x) '(10 11 12 13))) (entget (handent (car pair))))))
    (mapcar 'set '(pt21 pt22 pt23 pt24) (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (vl-position (car x) '(10 11 12 13))) (entget (handent (cadr pair))))))
    (setq d1l (vl-remove 0.0 (mapcar '(lambda ( a b ) (distance a b)) (list pt11 pt12 pt13 pt14) (list pt12 pt13 pt14 pt11))))
    (setq d2l (vl-remove 0.0 (mapcar '(lambda ( a b ) (distance a b)) (list pt21 pt22 pt23 pt24) (list pt22 pt23 pt24 pt21))))
    (setq ddl (unique (append d1l d2l)))
    (mapcar 'set '(pt1 pt2 pt3 pt4) (unique (append (list pt11 pt12 pt13 pt14) (list pt21 pt22 pt23 pt24))))
    (cond
      ( (vl-every '(lambda ( x ) (vl-position x ddl)) (list (distance pt1 pt2) (distance pt2 pt3) (distance pt3 pt4) (distance pt4 pt1)))
        nil
      )
      ( (vl-every '(lambda ( x ) (vl-position x ddl)) (list (distance pt2 pt1) (distance pt1 pt3) (distance pt3 pt4) (distance pt4 pt2)))
        (mapcar 'set '(pt1 pt2 pt3 pt4) (list pt2 pt1 pt3 pt4))
      )
      ( (vl-every '(lambda ( x ) (vl-position x ddl)) (list (distance pt1 pt3) (distance pt3 pt2) (distance pt2 pt4) (distance pt4 pt1)))
        (mapcar 'set '(pt1 pt2 pt3 pt4) (list pt1 pt3 pt2 pt4))
      )
      ( (vl-every '(lambda ( x ) (vl-position x ddl)) (list (distance pt1 pt2) (distance pt2 pt4) (distance pt4 pt3) (distance pt3 pt1)))
        (mapcar 'set '(pt1 pt2 pt3 pt4) (list pt1 pt2 pt4 pt3))
      )
      ( (vl-every '(lambda ( x ) (vl-position x ddl)) (list (distance pt4 pt2) (distance pt2 pt3) (distance pt3 pt1) (distance pt1 pt4)))
        (mapcar 'set '(pt1 pt2 pt3 pt4) (list pt4 pt2 pt3 pt1))
      )
      ( (vl-every '(lambda ( x ) (vl-position x ddl)) (list (distance pt3 pt2) (distance pt2 pt1) (distance pt1 pt4) (distance pt4 pt3)))
        (mapcar 'set '(pt1 pt2 pt3 pt4) (list pt3 pt2 pt1 pt4))
      )
      ( (vl-every '(lambda ( x ) (vl-position x ddl)) (list (distance pt1 pt4) (distance pt4 pt3) (distance pt3 pt2) (distance pt2 pt1)))
        (mapcar 'set '(pt1 pt2 pt3 pt4) (list pt1 pt4 pt3 pt2))
      )
    )
    (entmake (list '(0 . "3DFACE") (cons 10 pt1) (cons 11 pt2) (cons 12 pt3) (cons 13 pt4)))
    (entdel (handent (car pair)))
    (entdel (handent (cadr pair)))
    (entdel (handent (nth (vl-position (car pair) nnamesp) nnames)))
    (entdel (handent (nth (vl-position (cadr pair) nnamesp) nnames)))
  )
  (princ "\nTerminado ...")
  (princ)
)
;;fin defun

Regards, M.R.

[Anonymous]

Hello, thank you very much Marko
Forgive my lack of cooperation but not speak English

Best regard

[carlos_m_gil_p]

Hello marko_ribar

How are you.

You know you found a new error.

Watch in the DWG.

Thousand thanks.