;;
;; Meshout.lsp v3.01 by Andrew le Bihan
;; much needed sorting out by Stefan Lemke (in version 1)
;;
;; Visit www.accustudio.com for updates and information.
;;
;; You can do whatever you want with this code.  It'd be nice if you left the names in, but frankly
;; I don't care what you do.
;;
;; Meshout.lsp is a response to those people who think that creating a mesh from a solid using
;; the 3dsout/3dsin commands is too hard.  Meshout does the "whole thing" for you.  Having said that, in
;; writing this, I realised it's a bit harder than I thought, so this version cures some of the problems
;; with views and so on.
;;
;; This lisp program converts the selected 3D objects to meshes.  
;; Objects on the same layer will be joined together into one mesh.  This means you can also use
;; this lisp to join meshes together - for smoothing for example. 
;;
;; Version 3 is the first "complete" meshout.lsp.  It will take any meshable objects you throw at it
;; and convert them into meshes on the same layer as the original objects.  Old objects (if you decide to
;; keep them, are placed onto layers prefixed with "meshout_" (you can change this - see the start of the code)
;; All of the problems with views have been sorted out, and it should work a treat.  However, although I've
;; tested it a lot, I don't have all of the possible scenarios here - please report any problems you find.
;;
;; One thing to be careful of - the meshes created are not 100% accurate due to a fundamental limitation of the
;; process.  If you need total accuracy, don't use this.
;;
;; Enjoy.
;;
;; Comments and suggestions always welcome - send messages through www.accustudio.com to tools@accustudio.com
;;
;;
;; Revision history
;;	
;; Version 3.01 (16/02/2000) Corrected auto-welding problem
;;



(princ "\nmeshout.lsp v3.01 loading")

(defun C:meshout ( / prefix renderexist next1 newobjs ocm old setlay vlist i stub yorn ftsave version llist rmode oldlast vlist allowed new_nlist new_llist old_llist old_nlist)

(princ "\nMESHOUT 3.01 See lisp file for credits and instructions")
(setq 	allowed '("3DSOLID" "POLYLINE" "3DFACE" "REGION" "CIRCLE")		; allowed entity types
	prefix "meshout_"							; this is the old layer prefix.  You can change this
	ocm (getvar "cmdecho")							; to whatever you like.
	)                                 			; save command echo mode
(command "_undo" "_m")						; place an undo mark - you can undo all of meshout with "undo back"
(setvar "cmdecho" 0)                                          	; and switch it off
(setq	setlay (getvar "clayer")				; store the current layer
      	version (substr (getvar "acadver") 1 2)		      	; detect AutoCAD 2000 (version is "13", "14", or "15")
      	ftsave (getvar "facetres")		      	      	; save the value of "facetres" (meshing density)
      	rmode (getvar "regenmode")
	)
(command "_view" "_s" "meshout")			      	; save the current view (in order to restore it at the end)
(setq	vlist (getviewlist)					; save the views which currently exist
	llist (getfroz)						; llist is the frozen layer data
	)						
(princ "\nChoose the objects you want to convert to meshes:")	; prompt
(setq old (ssget))		      				; get the objects, saving what you chose in OLD
(princ "\nChecking selection")
(cond 	(old (setq old (check_old old allowed)))		; trap "no selection set"
	(T (setq old (ssadd)))
	)
(cond   ( (/= (sslength old) 0)
	(progn
	 (setq 	old_llist (getllist old)			; store the layer names and entity names of the original objects
		old_nlist (getnlist old old_llist)
		)
	 (command "_layer" "_m" "0" "")
	 (initget "Yes No")					      			; limit the choices
	 (setq yorn (getkword "\nDo you want to erase the old objects ? <N>: "))	; ask if old solids should be kept
	 (set_meshing_density)					; prompt for the meshing density and set the view and facetres
	 (setq renderexist (loadren version))			; load render.arx (store current state)
	 (setvar "regenmode" 0)					; turn off REGENAUTO (so we can muck about with the layers in peace)
	 (princ "\nCreating friendly layers")
	 (change_layers old)					; puts the objects onto friendly (to 3dsout, not to us) layer names
	 (princ "\nMeshing objects")
	 (c:3dsout old 0 0 -1 0.001 "weld.3ds")          		; this is the "clever" bit
	 (princ "\nSorting out existing objects")
	 (change_layers_back old_nlist (reverse old_llist))	; change the old objects back onto their original layers

	 (command "_layer" "_f" "*" "")				; current layer is "0". Freeze the others
								; because when the extra views come in, its much faster if everything's frozen
	 (setq oldlast (entlast))
	 (princ "\nImporting meshes")
	 (c:3dsin 0 0 0 "weld.3ds")				; here come the meshes - onto the "friendly" layers
	 (setq newobjs nil)
	 (setq 	new_nlist nil
	 	new_llist nil
		)
	 (princ "\nCollecting new meshes")
	 (setq next1 (entnext oldlast))				; creates a selection set of all of the new meshes
		(setq newobjs (ssadd))
		(while next1
			(progn
				(ssadd next1 newobjs)
				(setq next1 (entnext next1))
				)
			)
	 (setq 	new_llist (getllist newobjs)			; store the layer names and entity names of the new objects
		new_nlist (getnlist newobjs (cdr new_llist))
		
		)	
	 (if (null renderexist) (unloadrender version)		; unload render (if necessary)
		)
	 (princ "\nRestoring layers")
	 (restorelayers llist)					; reset all of the frozenness
	 (command "_chprop" newobjs "" "_c" "_bylayer" "")      ; and sorts out the colour (3dsin colours everything white)
	 (princ "\nDealing with old objects")
	 (cond 	((= yorn "Yes")(command "_erase" old ""))	; erase the old stuff, if required
		(T (moveold old prefix))			; or move the old stuff onto prefixed layers.
		)
	 (princ "\nCorrecting mesh layers")
	 (change_layers_back new_nlist old_llist)		; change the new objects layers onto the old layers
	 (dump_layers (cdr new_llist))
	 (princ "\nRemoving extra views")
	 (remove_extra_views vlist)				; 3DSIN duplicates the views - this gets rid of the extras
	 (setvar "regenmode" rmode)				; restore REGENAUTO setting
	 (command "_view" "_r" "meshout")			; restore the view we started with
	 (command "_view" "_d" "meshout")			; and get rid of the saved view
	 (command "_layer" "_s" setlay "") 			; restore the current layer
	 (command "_regenall")					; this is needed because REGENAUTO was off
	 (setq old nil)						; release the selection set from memory
	 (princ "\nDone - you can use UNDO BACK to undo this stuff")				
	 (princ)                                                ; helps keep exiting quiet
	); progn
	); (/= 0)
	(T (princ "\nNo meshable entities selected")		; if the selection set was filtered to nil, or if nothing
	)							; was selected
	); cond
(setvar "facetres" ftsave)				      	; restore FACETRES to normal
(setvar "cmdecho" ocm)                                       	; restore command echo mode

(princ)                                                      	; helps keep exiting quiet

)

;;
;;  This code checks that you enter a valid value for the meshing density, and then sets the view and facetres accordingly.
;;
;;
;;
(defun set_meshing_density ( / done newft1 )
	 (setq done nil)	      				
	  (while (not done)
	         (setq newft1 (getstring "\nNormal/<Meshing Density 1-100> <5>: "))
	         (cond ( (= newft1 "") (setq newft1 "5" done 1) )
		       ( (= (strcase newft1) "N") (setq done 1) ) 
	               ( (> (atof newft1) 100) (princ "\nRequires an value between 1 and 100.") )
	               ( (< (atof newft1) 1) (princ "\nRequires an value between 1 and 100.") )
		       ( (= (strcase newft1) "N") (setq done 1) )
		       ( T (setq done 1) )
	               )
	         )
	 (if (/= (strcase newft1) "N") (progn 			      			; only do this next bit if a meshing density has been set
				 	(command "_plan" "_w")	      			; zoom extents
	 			 	(command "_regen")	      			; and regen - this cuts out the zoom guessing game
					(setvar "facetres" (/ (atof newft1) 10))	; set FACETRES to the "meshing density" you set.	
			    		)
	 	)
	)

;;
;;  Save the frozenness state of the layers, so it can all be restored in "restorelayers"
;;
;;
;;
(defun getfroz ( / llist1 ldata)
(setq llist1 nil)
(setq ldata (tblnext "layer" T))						; saves the "frozenness" of the layers
	(while ldata								; this will be used later
		(setq   llist1 (cons (= (rem (cdaddr ldata)) 1) llist1)		; to defeat the evil "creating camera" problem
		        llist1 (cons (cdadr ldata) llist1)		      
			ldata (tblnext "layer")
	
		)
	)
(mo_return llist1)
)



;;
;;  Using the list from "getfroz", recreate the frozenness of all of the layers in the drawing
;;
;;
;;
(defun restorelayers (llist1 / ldata layfroz lname)
  	(command "_layer" "_T" "*" "")
	(setq	lname (car llist1)
		layfroz (cadr llist1)
		llist1 (cddr llist1)
		)

	(while lname
		(progn
			(if layfroz
				(command "_layer" "_F" lname "")
				)
			(setq	lname (car llist1)
				layfroz (cadr llist1)
				llist1 (cddr llist1)
				) 
			)
		)
)




;;
;;  Creates a list of all of the views in the drawing, so they can be checked against the final result
;;
;;
;;
(defun getviewlist ( / vlist1 data )
	(setq data (tblnext "view" T))			      		; this stores all of the view names, so that additional views
	(while data (setq 	vlist1 (cons (cdr (cadr data)) vlist1) 	; can be erased after the 3dsin
				data (tblnext "view"))
		) 
	(mo_return vlist1)
)





;;
;;  Using the "getviewlist" list, remove any new views that are not on the list
;;
;;
;;
(defun remove_extra_views (vlist1 / data vname)
	 (setq data (tblnext "view" T))
	 (while data (progn								; removes views which were not present at
			(setq 	vname (cdr (cadr data))					; the start
				data (tblnext "view")
				flag "0"
				)
			(foreach n vlist1 (if (= n vname) (setq flag "1")))	
			(if (= flag "0") (command "_view" "_d" vname))
			)	
		)
	)


;;
;;  Load "render.arx" or "acrender.arx" depending on the AutoCAD version
;;
;;
;;
(defun loadren ( version1 / n renderexist1) 
 (setq renderexist1 nil)	                                      					; rentest is whether or not "render.arx" was loaded at the start or not.
 (cond	((= version1 "15") (progn 
 				(foreach n (arx) (if (= n "acrender.arx") (setq renderexist1 T))) 	; pretty basic code to find "acrender.arx" in the (arx) list.
 				(if (not renderexist1) (arxload "acrender"))                      	; load "acrender.arx" if not loaded already (AutoCAD 2000)
				))
	(T (progn
				(foreach n (arx) (if (= n "render.arx") (setq renderexist1 T))) 	; pretty basic code to find "render.arx" in the (arx) list.
 				(if (not renderexist1) (arxload "render"))                     	; load "render.arx" if not loaded already (AutoCAD r14/r13)
				))
	)
 (mo_return renderexist1)
 )




;;
;;  Unload "render.arx" or "acrender.arx" depending on the AutoCAD version
;;
;;
;;
(defun unloadrender (version1)
	 (cond 	((= version1 "15") 	(arxunload "acrender"))	; unload "acrender.arx"
		(T			(arxunload "render"))	; unload "render.arx"
	  )
)        



;;
;;  This routine moves the original objects onto layers prefixed with "meshout_"
;;  and then freezes the layers.
;;
;;
(defun moveold( ss1 prefix1 / llist nlist layname objs objname fulllname)
	(setq llist (getllist ss1))
	(setq nlist (getnlist ss1 llist))
	(setq llist (reverse llist))
	(foreach layname llist
		(progn
			(setq fulllname (strcat prefix1 layname))
			(setq 	objs (car nlist)
				nlist (cdr nlist)
				)
			(foreach objname objs
				(newname fulllname objname)
				)
			(command "_layer" "_f" fulllname "")
			)
		)
	(setq ss1 nil)
	)
				

;;
;;  Used by "moveold" to get a list of the layers the objects are on
;;  
;;
;;
(defun getllist (ss1 / llist count flag lname)
	(setq llist nil)
	(setq count (sslength ss1))
	(while (/= count 0)
		(progn
			(setq 	count (- count 1)
				flag nil
				lname (cdadr(cddddr(entget (ssname ss1 count))))
				)
			(foreach n llist
				(if (= n lname) (setq flag T)	
					)
				)
			(if (not flag)
				(setq	llist (cons lname llist))
				)
			)
		)
	(mo_return (acad_strlsort llist))
	)


;;
;;  Used by "moveold" to write a list of object names sorted by layer
;;  
;;
;;
(defun getnlist (ss1 llist / nlist count2 nlist1 lname)
	(setq count1 (sslength ss1))
	(setq nlist nil)
	(foreach n llist
		(progn
			(setq 	count2 count1
				nlist1 nil
				)
			(while (/= count2 0)
				(progn
					(setq 	count2 (- count2 1)
						lname (cdadr(cddddr(entget (ssname ss1 count2))))
						)
					(if (= lname n)
						(setq nlist1 (cons (ssname ss1 count2) nlist1))
						)
					)
				)
			(setq nlist (cons nlist1 nlist))
			)
		)
	(mo_return nlist)
	)


;;
;;  Used by "moveold" to change the layer of the object to the given layername
;;  
;;
;;
(defun newname ( layername en / fullname ed )
	(setq ed (entget en))				;Sets ed to the entity data of entity  en 
	(setq ed (subst (cons 8 layername) (assoc 8 ed) ed)) 
	(entmod ed)					;Modifies entity en's layer in drawing 
	)



;;
;;  Finds the added meshes by referencing the stored "old last" object name, and going from there.
;;  
;;
;;
(defun getadded ( / ss next1 entnext)
	(setq next1 (entnext oldlast))
	(setq ss (ssadd))
	(while next1
		(progn
			(ssadd next1 ss)
			(setq next1 (entnext next1))
			)
		)
	(mo_return ss)
	)

;;
;;  Puts all of the objects in the selection set onto numbered layers
;;  because 3dsout can't handle layer names longer than 10 characters
;;  bless it.
;;
(defun change_layers ( ss1 / llist nlist layname objs objname count)
	(setq llist (getllist ss1))
	(setq nlist (getnlist ss1 llist))
	(setq count 1)
	(foreach layname llist
		(progn
			(setq 	objs (car nlist)
				nlist (cdr nlist)
				)
			(foreach objname objs
				(newname (strcat "meshout_" (strnum count)) objname)
				)
			(setq count (+ count 1))
			)
		)
	)


;;
;;  Changes the objects passed onto the layers passed (in the same order)
;;  
;;
;;
(defun change_layers_back ( nlist llist / layname objs objname fulllname)
	(foreach layname llist
		(progn
			(setq 	objs (car nlist)
				nlist (cdr nlist)
				)
			(foreach objname objs
				(newname layname objname)
				)
			)
		)
	)

;;
;;  Changes the objects passed onto the layers passed (in the same order)
;;  
;;
;;
(defun dump_layers ( llist / layname)
	(foreach layname llist
		(command "_purge" "_la" layname "_y" "_y") 
		)
	)


;;
;;  Converts a number into a 2 character string
;;  
;;
;;
(defun strnum (input / strnum)
	(setq strnum (itoa input))
	(if (= (strlen strnum) 1) (setq strnum (strcat "0" strnum))
		)
	(mo_return strnum)
	) 

;;
;;  Filter for certain entity types
;;  
;;
;;
(defun check_old (ss1 allowed / new_ss count type )
	(setq new_ss (ssadd))
	(setq count (sslength ss1))
	(while (/= count 0)
		(progn
			(setq count (- count 1))
			(foreach type allowed
				(if (= (cdadr(entget (ssname ss1 count))) type)
					(ssadd (ssname ss1 count) new_ss)
					)
				)
			
			)
		)
	(mo_return new_ss)
	)

	

;;
;;  Make act of returning a value explicit.
;;
;;
;;
(defun mo_return (value) value)


;;
;;  Used in testing to return the entity type of a selected object
;;
;;
(defun c:getename( / ename)
	(setq ename (cdadr(entget (ssname (ssget) 0))))
	)

(princ)