;|  M2S.lsp  (Mesh-to-Solid)
    Creates a 3Dsolid from an old-style open 3d polygon mesh, 
    but NOT from an AutoCAD 2010-style MESH object*solidhist*solidhist*solidhist
  
    Set MESHTYPE to 0 to create old-style polygon meshes.

  Works with all open meshes created with REVSURF, RULESURF,
EDGESURF, TABSURF, AI_MESH, and 3DMESH. Most of the stock 3D
surfaces will work if you use DDMODIFY to open them in the M
and N directions.

  This was written to create sculptable ACIS terrain models
for architectural site renderings. It can also be used
to create thin shells from meshes, by subtracting a moved or scaled-down
copy of the solid from the original solid, but AutoCAD's native
Solids Editing > Shell now does a better job of this in most cases.

  The solid is created by projecting each mesh facet "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.

  The solid will match the displayed mesh: if the mesh has
been smoothed and SPLFRAME is set to 0, the solid will be
smoothed. Otherwise, it will not be. The mesh itself is not
changed at all.


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.

v 1.4 - 9/15/2008 - minor code cleanup and speed improvements
v 1.5 - 3/8/2010  - AutoCAD 2010 compatibility, modularized code
                  - GRIDMODE and UCSICON set to prevent flicker
|;

(defun c:m2s 
( / 
en ed M N MN SN SM ST smooth vtx d1
*cmdecho *osmode *blipmode *gridmode *solidhist
low vtxcnt vtxmax bot bottom p1 p2 p3 p4 c1 c2 c3 c4
b1 b2 b3 b4 soldepth ssall ssrow
myerror setup selectMesh getLowestVertex getThickness 
initializeSets createSolids unionSolids
)


(defun myerror (msg)
  (setvar 'osmode   *osmode)
  (setvar 'blipmode *blipmode)
  (setvar 'gridmode *gridmode)
  (setvar 'ucsicon *ucsicon)
  (if R17 (setvar 'solidhist *solidhist))
  (setq *error* olderror)
  (princ msg)\
  (setvar 'modemacro ".")
  (setvar 'cmdecho  *cmdecho)
  (command "_.undo" "_end")
)


(defun setup ()
  (command "_.undo" "_begin")
  (setq *cmdecho  (getvar 'cmdecho))
  (setq *osmode   (getvar 'osmode))
  (setq *blipmode (getvar 'blipmode))
  (setq *gridmode (getvar 'gridmode))
  (setq *ucsicon  (getvar 'ucsicon))  
  (setq olderror *error*)
  (setq *error* myerror)
  (setvar 'cmdecho 0)
  (setvar 'osmode 0)
  (setvar 'blipmode 0)
  (setvar 'gridmode 0)
  (if (< 16 (atoi (substr (getvar 'acadver) 1 2)))
    (progn
      (setq R17 T)
      (setq *solidhist (getvar 'solidhist))
      (setvar 'solidhist 0))
      )
  (if (member "acetutil.arx" (arx)) (setq ETloaded T))      
)

(defun selectMesh ()
  (setq en (car (entsel "Select a polygon mesh to solidify: ")))
  (setq ed (entget en))
  (if (not (= (cdr (assoc 0 ed)) "POLYLINE"))
    (progn
      (alert "That is not a polygon mesh.")
      (exit)
      (princ)
    );progn
  );endif
  (if
    (not
      (or
       (= (cdr (assoc 70 ed)) 16) ;open 3d polygon mesh
       (= (cdr (assoc 70 ed)) 20) ;open mesh w/ spline-fit vertices
        );or
       );not
     (progn
       (alert "That is not an *open* polygon mesh.")
       (exit)
       (princ)
     );progn
  );endif
;; decide whether to use smoothed or unsmoothed vertices
  (setq M (cdr (assoc 71 ed)))   ;M vertices
  (setq N (cdr (assoc 72 ed)))   ;N vertices
  (setq SM (cdr (assoc 73 ed)))  ;smoothed M vertices
  (setq SN (cdr (assoc 74 ed)))  ;smoothed N vertices
  (setq ST (cdr (assoc 75 ed)))  ;surface type
  (if
    (or
      (= (getvar "splframe") 1)      ;use MxN vertices when splframe = 1
      (= ST 0)                       ;or mesh has not been smoothed
      )
    (setq smooth 0
         MN (* M N))
    (setq smooth 1                   ;use SMxSN vertices when mesh is smoothed
          MN (* SM SN)               ;and SPLFRAME = 0
          M SM
          N SN)
    );if
)

(defun getLowestVertex ()
  (setq vtx en)
  (setq vtx (entnext vtx))
  (setq d1 (entget vtx))
  (setq bottom (caddr (trans (cdr (assoc 10 d1)) 0 1)))
  (repeat (1- MN)   ;compare with each vertex's z coord
    (setq vtx (entnext vtx))
    (setq d1 (entget vtx))
    (setq low (caddr (trans (cdr (assoc 10 d1)) 0 1)))
    (setq bottom (min bottom low))
    );repeat
)

(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 p1 en)
  (if (= smooth 1)
      (setq p1 (entnext p1))) ;skip 1st vtx of smoothed mesh - not true vtx
  (setq ssrow (ssadd))        ;initialize set of extruded segments to be unioned as a row
  (setq ssall (ssadd))        ;initialize set of rows to be unioned into the whole
)


(defun createSolids ()
  (setvar 'ucsicon 0) ;; kill flicker a bit
  (setq vtxmax (- MN N))
  (setq vtxcnt 1)
  (while (< vtxcnt vtxmax)
    (if (= 0 (rem vtxcnt N))  ;at end of each row...
        (progn
          (command "_.union" ssrow "")
          (ssadd (entlast) ssall)
          (setq ssrow (ssadd))
          (setq p1 (entnext p1)         ;skip to the next vertex
                vtxcnt (1+ vtxcnt))
          );progn
        );if
    (setq p1 (entnext p1)                  ;first vertex of mesh square
          p2 (entnext p1)                  ;second vertex
          p3 p2)
    (repeat (1- n) (setq p3 (entnext p3))) ;walk along to 3rd (p1 + N) vertex
    (setq p4 (entnext p3))                 ;4th vertex of mesh square
    (setq c1 (trans (cdr (assoc 10 (entget p1))) 0 1) ;top coordinates in UCS
          c2 (trans (cdr (assoc 10 (entget p2))) 0 1)
          c3 (trans (cdr (assoc 10 (entget p3))) 0 1)
          c4 (trans (cdr (assoc 10 (entget p4))) 0 1)
          b1 (list (car c1) (cadr c1) bot)            ;bottom coordinates in UCS
          b2 (list (car c2) (cadr c2) bot)
          b3 (list (car c3) (cadr c3) bot)
          b4 (list (car c4) (cadr c4) bot))
    (M2SLOFT c1 c2 c3 b1 b2 b3)
    (M2SLOFT c2 c3 c4 b2 b3 b4)
    (setvar 'modemacro (strcat "Creating solids: " 
                       (rtos (* 100 (/ vtxcnt vtxmax 1.0)) 2 0) 
                        "%       "))
    (setq vtxcnt (1+ vtxcnt))
  );while
)

(defun unionSolids ()
  (command "_.union" ssrow "")
  (setq row (entlast))
  (ssadd row ssall)
  (if (> M 2)       ;bypass final union for N x 1 meshes (i.e., RULESURF)
      (command "_.union" ssall "")
      );if
)


(defun M2SLOFT (r1 r2 r3 s1 s2 s3 / extr highest)
  (if
    (> (area3p s1 s2 s3) 0.00000001)
    (progn
      (entmake (list  (cons 0 "3DFACE")
                      (cons 10 (trans s1 1 0))  ;;WCS points
                      (cons 11 (trans s2 1 0))
                      (cons 12 (trans s3 1 0))
                      (cons 13 (trans s3 1 0)))
                      )
      (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
      (command "_.slice" (entlast) "" "_3points" r1 r2 r3 s1)
      (ssadd (entlast) ssrow)
      );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)
(selectMesh)
(getLowestVertex)
(getThickness)
(initializeSets)
(createSolids)
(unionSolids)
(myerror "\nM2S complete.")

);defun


(princ "Mesh-to-Solid loaded. Type  M2S  to run the program.")
(princ)