;|   F2S.lsp  (Faces-to-Solid) Creates a 3Dsolid from selected 3dfaces

by Bill Gilliss
bill at realerthanreal dot com
Comments and suggestions always welcome.

No warranty, either expressed or implied, is made as to the fitness of
this information for any particular purpose.  All materials are to be
considered 'as-is', and use thereof should be considered as at your own
risk.

Release Notes:
1.00  8/23/2006  - Original release.
1.01  8/26/2006  - SPLFRAME=1 to be sure faces are visible and therefore selectable.
                 - polyline area threshold increased to prevent solid creation errors.
1.02  8/28/2006  - international syntax fix.
1.03  7/13/2007  - Option added to erase faces as they are converted to solids.
1.10   3/8/2010  - 2010 compatible (change in AREA command) and rewritten as modular code
                 - GRIDMODE and UCSICON set to prevent flicker

Summary:
  As in M2S.lsp, the solid is created on the current layer by projecting each
selected face vertically "down" the CURRENT z-axis to a plane a user-specified
distance below the lowest vertex. To assure that all parts of the mesh are
generated as solids, this distance can not be zero, but the solid can be SLICEd
later if need be.
  Quite complex solids can be created by projecting the faces along several different
axes, then using INTERFERE or INTERSECT to create the final solid from the
intermediate ones.

Notes:
 - Thanks to Gilles Chanteau, Dr. Heinz-Joachim Schulz, and Robert Morin
 - Works with all releases that support 3D solids.
 - If adjacent faces do not have identical coordinates, there will be very
small gaps or overlaps between the solids derived from them, which can
cause AutoCAD to fail to be able to union the solids. Common results:
      "Inconsistent containment of intersection curve."
      "Inconsistent information in vertex and coedge coordinates."
      "Inconsistent edge-face relationships."
      "Inconsistent face-body relationships."
      "Curves osculate at vertex - cannot evaluate order."
  The best way to fix the face vertices before running F2S is to use 3DSOUT
with Auto-Welding turned on with an appropriate threshold, then 3DSIN to bring
the welded mesh back into AutoCAD, then EXPLODE and run F2S. The larger the
threshold distance, the fewer the problems.
   3DS MAX and Rhino can also do the vertex welding when importing an AutoCAD file.
If one of these are available, save or wblock the faces to a new DWG file, and then
import the new file with Weld turned on with an appropriate threshold.
Export to 3DS format, and then use 3DSIN in AutoCAD.
   The ANNEAL command in EasySite from Cadeasy Corp will also fix the 3dface vertices
with a user-specified tolerance, without leaving AutoCAD.
   If problematic solids do persist, copying them a small distance and then
unioning the copies with the original will usually fill the gaps and resolve
these problems.
   Some manual unioning might still be necessary with any of these approaches --
deal with it.

Keywords: AutoCAD AutoLISP 3dsolid 3dface face convert
=========================================================================
|;
(defun c:f2s (/ ss ent ed bot bottom partialsolid R17 n partialsolid num
                 low10 low11 low12 low13
                 p1 p2 p3 p4 c1 c2 c3 c4 b1 b2 b3 b4
                 soldepth sspartial ssfinal ETloaded
                 *solidhist *cmdecho *osmode *blipmode *splframe
                 myerror setup getFaces getLowestVertex getThickness initializeSets
                 createSolids unionSolids getPoints area3p F2SLoft
                 )

;;-----subroutines----------------
(defun myerror (msg)
  (princ msg)
  (setvar 'osmode    *osmode)
  (setvar 'blipmode  *blipmode)
  (setvar 'delobj    *delobj)
  (setvar 'splframe  *splframe)
  (setvar 'solidhist *solidhist)
  (setvar 'gridmode *gridmode)
  (setvar 'ucsicon *ucsicon)  
  (setvar 'modemacro ".")
  (command "_.undo" "_end")
  (setq *error* olderror)
  (setvar 'cmdecho *cmdecho)
  (princ)
)


(defun setup ()
  (command "_.undo" "_begin")
  (setq *cmdecho (getvar 'cmdecho))
  (setq *osmode   (getvar 'osmode))
  (setq *blipmode (getvar 'blipmode))
  (setq *delobj   (getvar 'delobj))
  (setq *splframe (getvar 'splframe))
  (setq *gridmode (getvar 'gridmode))
  (setq *ucsicon  (getvar 'ucsicon))  
  (setvar 'cmdecho 0)
  (setvar 'osmode 0)
  (setvar 'blipmode 0)
  (setvar 'delobj 1)
  (setvar 'splframe 1)  ;; edges must be visible for faces to be selectable
  (setvar 'gridmode 0)  ;; avoids flicker 
  (command "_.regen")
  (if (< 16 (atoi (substr (getvar "acadver") 1 2))) (setq R17 T))
  (if R17 (setq *solidhist (getvar 'solidhist)))
  (if R17 (setvar 'solidhist 0))
  (setq olderror *error*)
  (setq *error* myerror)

(alert
"Face-to-Solid loaded. Type  F2S  to run the program.
\nNote: if many faces are selected, AutoCAD may crash due to memory
limitations when unioning the many solids created from them, so please
\nSAVE ALL OPEN DRAWINGS \n
before using this routine with large numbers of faces. The routine
will prompt for automatic or manual unioning; select manual to do the
unioning yourself in smaller increments if automatic causes problems.
\nAlso, see the introductory comments in the LISP file about cleaning up
face coordinates to avoid unioning errors.")
)


(defun getFaces ()
  (prompt "Select 3dface(s) to solidify: ")
  (setq ss (ssget '((0 . "3dface"))))
  (initget 1 "Yes No")
  (setq erasefaces (getkword "Erase faces [Yes or No]: "))
)

(defun getLowestVertex ()
  (setq ent (ssname ss 0))
  (setq ed (entget ent))
  (setq bottom (caddr (trans (cdr (assoc 10 ed)) 0 1)))

  ;;find lowest vertex in selection set of faces
  (setq n 0)
    (while
    (< n (sslength ss))
    (progn
      (setq ent (ssname ss n))
      (setq ed (entget ent))
      (setq low10 (caddr (trans (cdr (assoc 10 ed)) 0 1)))
      (setq low11 (caddr (trans (cdr (assoc 11 ed)) 0 1)))
      (setq low12 (caddr (trans (cdr (assoc 12 ed)) 0 1)))
      (setq low13 (caddr (trans (cdr (assoc 13 ed)) 0 1)))
      (setq bottom (min bottom low10 low11 low12 low13))
      (setq n (1+ n))
      );progn
  );while
)

(defun getThickness ()
  (setq soldepth 0)
  (while
     (zerop soldepth)
     (progn
       (setq soldepth (getdist "\nEnter desired thickness of solid below lowest vertex <1>: "))
       (if (not soldepth) (setq soldepth 1.0))
       (if (zerop soldepth)
          (princ "\nThickness can be small, but not zero. (Slice it later, if need be.)"))
       );progn
     );while
  (setq bot (- bottom (abs soldepth)))
)

(defun initializeSets ()
  (setq sspartial (ssadd))  ;initialize partial set of extruded segments to be unioned together
  (setq ssfinal (ssadd))    ;initialize final set of solids

  (princ "\nUnioning large number of small solids can lock up AutoCAD")
  (princ "\nif memory limits are exceeded. Would you like to continue")
  (princ "\nwith automatic unioning, or union them manually?")
  (initget 1 "Auto Manual")
  (setq reply (getkword " Auto or Manual?"))
  (setq reply (substr reply 1 1))
)

(defun createSolids ()
  (setvar 'ucsicon 0) ;; kill flicker a bit
  (setq num (sqrt (sslength ss)))  ;;number of partial solids to create
  (setq n 0)
  (setq partialsolid 0)
  (setq time1 (getvar "DATE"))
  (setq sslen (sslength ss))
  (while
    (< n sslen)
    (progn
      (getPoints)
      (F2SLoft c1 c2 c3 b1 b2 b3)
      (F2SLoft c3 c4 c1 b3 b4 b1)
      (if (= erasefaces "Yes") (entdel ent))
      (setq partialsolid (1+ partialsolid))

      (if
       (or (>= partialsolid num) (= n (1- (sslength ss))))
        (if (= reply "A")
          (progn
            (setq partialsolid 0)
            (command "_.union" sspartial "")
            (ssadd (entlast) ssfinal)
            (setq sspartial (ssadd))   ;;re-initialize with empty set
            );progn
          );if
        );if

    (setvar 'modemacro (strcat "Creating solids: " 
                       (rtos (* 100 (/ n sslen 1.0)) 2 0) 
                        "%       "))
     (setq n (1+ n))
    );progn
  );while
)

(defun unionSolids ()
  (if (= reply "A")
    (progn
      (grtext -1 "Unioning final solid...")
      (command "_.union" ssfinal "")
      );progn
    );if
)

(defun getPoints()
  (setq ent (ssname ss n))
  (setq ed (entget ent))
  (setq p1 (assoc 10 ed)                 ;first vertex of face
        p2 (assoc 11 ed)
        p3 (assoc 12 ed)
        p4 (assoc 13 ed))
  (setq c1 (trans (cdr p1) 0 1)          ;top coordinates
        c2 (trans (cdr p2) 0 1)
        c3 (trans (cdr p3) 0 1)
        c4 (trans (cdr p4) 0 1))
  (setq b1 (list (car c1) (cadr c1) bot) ;bottom coordinates
        b2 (list (car c2) (cadr c2) bot)
        b3 (list (car c3) (cadr c3) bot)
        b4 (list (car c4) (cadr c4) bot))
)


(defun F2SLoft (r1 r2 r3 s1 s2 s3 / e1 extr highest)
  (if (> (area3p s1 s2 s3) 0.000001) ;;avoid problems with tiny solids
    (progn
      (command "_.pline" s1 s2 s3 "_close")
      (setq highest (max (caddr r1) (caddr r2) (caddr r3)))
      (setq extr (- highest bot))
      (if
        R17
        (command "_.extrude" (entlast) "" extr)     ;;2007 and higher
        (command "_.extrude" (entlast) "" extr 0.0) ;;2006 and below
        );endif

      (if                  ;;don't slice if top is flat
       (not
        (and
          (equal (caddr r1) (caddr r2))
          (equal (caddr r1) (caddr r3))
          );and
         );not
       (command "_.slice" (entlast) "" "_3points" r1 r2 r3 s1)
       );if
     (ssadd (entlast) sspartial)
     );progn
    );if
  );defun


(defun area3p (p1 p2 p3 / a b c s)
	(setq
		a (distance p1 p2)
		b (distance p2 p3)
		c (distance p3 p1)
		s (* 0.5 (+ a b c))
	)
	(sqrt
		(*
			s
			(- s a)
			(- s b)
			(- s c)
		)
	)
)


;;========== MAIN ROUTINE =========================
  (setup)
  (getFaces)
  (getLowestVertex)
  (getThickness)
  (initializeSets)
  (createSolids)
  (unionSolids)
  (myerror nil) ;;cleanup

);defun F2S

(princ "Face-to-Solid loaded. Type  F2S  to run.")
(princ)