[Radiance-general] Radout
Mark de la Fuente
MdelaFuente at wmtao.com
Thu Aug 5 07:02:15 PDT 2010
Hind,
I still use the old torad program when going from AutoCAD to Radiance. (From what I remember it is slower than radout) Unfortunately there was an autocad version check that kept it from working right on newer AutoCADs. We fixed a layer bug and changed the autocad version to work on 2007. If you are running 2010, you will have to find the comments we added and change from version 17 to whatever version 2010 is (18?).
Below are the contents of torad.lsp. You will have to replace the contents of your file with the following text. Sorry this is long, but I don't think you can attach files.
I believe torad is available from the official radiance website.
Hope that helps.
Mark de la Fuente
;;; ***************************************************************************
;;; torad.lsp
;;; export RADIANCE scene description files from Autocad.
;;;
;;; Copyright (C) 1993 by Georg Mischler / Lehrstuhl
;;; fuer Bauphysik ETH Zurich.
;;;
;;; Permission to use, copy, modify, and distribute this software
;;; for any purpose and without fee is hereby granted, provided
;;; that the above copyright notice appears in all copies and that
;;; both that copyright notice and this permission notice appear in
;;; all supporting documentation.
;;;
;;; THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED
;;; WARRANTY. ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR
;;; PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED.
;;;
;;; Acknowlegdements:
;;; Final developement of this program has been sponsored by Prof. Dr.
;;; B. Keller, Building Physics, Dep. for Architekture ETH Zurich.
;;; The developement environment has been provided by Prof. Dr.
;;; G. Schmitt, Architecture & CAAD ETH Zurich.
;;;
;;; Edited by AKS on 9/12/06 to get it to work right. Some errors and
;;; updating were required.
;;;
;;; ***************************************************************************
;;; general environment setup.
;;; load compiled files if possible or else sources.
(progn
(setq *torad_preverr* *error*
*error* '((msg)
(setq *error* *torad_preverr*)
(prompt "Load failed for torad.lsp!\n")
(if (null BD4A)
(prompt "Extended Lisp compiler not supported on this platform!\n"))
(princ) ) )
(if (null *col*) (setq *col* 10))
(if (null *toradtypelist*) (setq *toradtypelist*
'("3DFACE""TRACE""SOLID""LINE""PLINE""WPLINE""CIRCLE""ARC""PMESH""PFACE")) )
(if (null *exportsmode*) (setq *exportsmode* "Color" ))
(if (null *exportnsegs*) (setq *exportnsegs* 16 ))
(if (null *toraddlgpos*) (setq *toraddlgpos* '(-1 -1)))
(cond ( (null (or (and BD4A (load "esample.bi4" NIL)) (load "esample" NIL)))
(prompt "Can't load sampling functions from \"esample.lsp\"!\007\n")
(exit) )
(T NIL) )
(cond ( (null (or (and BD4A (load "vector.bi4" NIL)) (load "vector" NIL)))
(prompt "Can't load vector functions from \"vector.lsp\"!\007\n")
(exit) )
(T NIL) )
)
;;; ***************************************************************************
(defun *torad_error* (msg)
;; error handling for torad.lsp.
(cond ( (and (/= "console break" msg)
(/= "Function cancelled" msg))
(terpri)
(princ msg) ))
(torad_reset) )
(defun torad_setup ()
;; global setup for torad.lsp.
(regapp "MKVOL_LSP_01")
(setq *Exportentlist* NIL
*exportblocklist* NIL
*FILE* NIL
*torad_preverr* *error*
*error* *torad_error*
))
(defun torad_reset ()
;; global reset for torad.lsp.
(if *FILE* (close *FILE*))
(setq *error* *torad_preverr*
*error* *torad_preverr*
*FILE* NIL
*exportentlist* NIL
*exportblocklist* NIL
*valuablepolylist* NIL )
(princ) )
;;; ***************************************************************************
(defun c:torad (/ stat fname selset blocklevel home dwg
filelist matlist erot sun view)
;; main control.
(torad_setup)
(setq *exporttruelays* (vislaylist)) ; collect names of visible layers.
; It is here where the original torad.lsp was loading the dialog only
; if the version was 12.
; original was (if (and (wcmatch (getvar "acadver") "12*")
; This changes it to 16.
; Changed the 16 to 17 for ACAD 2007.
(if (and (wcmatch (getvar "acadver") "17*")
(findfile "torad.dcl") )
(setq stat (torad_dlg)
filelist *toradfilelist* )
(setq stat -1) )
(if (> 0 stat)
(setq filelist (setradparams)
*toradfilelist* filelist
stat 1) )
(cond ( (< 0 stat)
(setq blocklevel 1)
(setq fname (strcase (cdr (assoc "prefix" filelist)) T))
(cond ( (and (assoc "files" filelist)
(setq selset (ssget)) )
(makeentlist )
(setq *valuablepolylist* *toradtypelist*)
(sampleents selset )
(while *exportblocklist*
(sampleblocks blocklevel )
(setq blocklevel (1+ blocklevel)) )
(setq matlist (writerad fname))
(if (assoc "mat" filelist)
(writeradmatlist fname matlist) )
(if (setq erot (cdr (assoc "master" filelist)))
(writeradtot fname erot matlist) )
(if (assoc "make" filelist)
(writeradmake fname matlist) ) )
(T NIL) )
(if (setq view (cdr (assoc "view" filelist)))
(writeradview fname view) )
(if (setq sun (cdr (assoc "light" filelist)))
(writeradsun fname sun) )
)
(T NIL) )
(torad_reset ) )
;;; GENERAL SETUP **********************************************************
;;; currently supported entity types for torad.
(setq *toradetypes* '(
("3DFACE" "\n Planarized faces of 3DFACEs" )
("TRACE" "\n Extruded and flat TRACEs" )
("SOLID" "\n Extruded and flat SOLIDs" )
("CIRCLE" "\n Extruded and flat CIRCLEs" )
("ARC" "\n Extruded faces of ARCs" )
("LINE" "\n Extruded faces of LINEs" )
("PLINE" "\n Extruded faces of 2D-PLINEs" )
("WPLINE" "\n Constant width of 2D-PLINES" )
("POLYGON" "\nClosed 2d-polylines as POLYGONs" )
("PMESH" "\n Faces of 3D-MESHes" )
("PFACE" "\n Faces if POLYFACEs" )
("POINT" "\n Points as SPHEREs or BUBBLEs" )
))
(defun setradparams (/ filelist typelist types wcsrot dwg home fname)
;; setup on older versions than 12.
(toradshowitems nil)
(prompt "\n\n Entity data collected by: ")
(princ *exportsmode*)
(prompt "\n Number of segments for circles: ")
(princ *exportnsegs*)
(initget "Yes No")
(cond ( (= "Yes"
(getkword "\n\n Do you want to change anything? <No>: "))
(terpri)
(foreach item *toradetypes*
(toradsetitem (car item) nil))
;; It is here where the original torad.lsp was using the wrong proceedure names
;; for setradsamplemode and setradnumsegs. The "rad" was left out of the names
;; as if there had been a last min. edit to change names. AKS 9/12/06
(setradsamplemode nil)
(setradnumsegs nil)
)
( T NIL) )
(initget "Yes No")
(cond ( (/= "No" (getkword "\n Write geometry data to file <Yes>?: "))
(setq filelist '(("files")))
(initget "Yes No")
(cond ( (= "Yes"
(getkword "\n Write organizing control-file <No>?: "))
(setq wcsrot
(getreal "\n WCS rotation from East to X <0.0>: ")
filelist (cons (cons "master" (if wcsrot wcsrot 0.0))
filelist) )
(initget "Yes No")
(if (= "Yes"
(getkword "\n Write execution rules to makefile <No>?: "))
(setq filelist (cons '("make") filelist)) ) ) )
(initget "Yes No")
(if (= "Yes"
(getkword "\n Write materials (all same) to file <No>?: "))
(setq filelist (cons '("mat") filelist)) ) )
(T NIL) )
(initget "Yes No")
(if (= "Yes"
(getkword "\n Write view to view-file <No>?: "))
(setq filelist (cons (cons "view" (askview)) filelist)) )
(initget "Yes No")
(if (= "Yes"
(getkword "\n Write sun definition to file <No>?: "))
(setq filelist (cons (cons "light" (asksun)) filelist)) )
(setq dwg (getvar "DWGNAME")
fname (getstring
(strcat "\n\nprefix for output-file <" dwg ">: ")))
(if (= 0 (strlen fname)) (setq fname dwg))
(if (and (= "~" (substr fname 1 1))
(setq home (getenv "HOME")) )
(setq fname (strcat home (substr fname 2) )) )
(cons (cons "prefix" fname) filelist) )
(defun toradshowitems (stdalone / types typelist)
;; display setting of sampled entity types.
(textpage)
(if stdalone (torad_setup))
(setq types *toradetypes*
typelist *toradtypelist* )
(prompt "\n\n TORAD sampling modes:")
(prompt "\n -------------------------------")
(prompt "\n\n Collected entities:\n")
(foreach item types
(princ (strcat (cadr item) ": "))
(princ (if (member (car item) typelist) "Y" "N")) )
(if stdalone (torad_reset)) )
(defun toradsetitem (item stdalone / types old new tstr oldl newl)
;; set sampled entity types.
(if stdalone (torad_setup))
(initget "Yes No")
(setq oldl *toradtypelist*
types *toradetypes*
tstr (assoc item types)
old (if (member (car tstr) oldl) "Y" "N")
new (getkword (strcat (cadr tstr) " <" old ">: ")) )
(cond ( (and new (/= 0 (strlen new))
(/= old (setq new (substr new 1 1))))
(setq newl (if (= New "Y")
(cons item oldl)
(append (cdr (member item oldl))
(cdr (member item (reverse oldl))) ) ) )
(setq *toradtypelist* newl) )
(T NIL) )
(if stdalone (torad_reset)) )
(defun askview (/ vlist num view res)
;; set view number to export.
(setq vlist (list (cons 0 "Current"))
num 0
res -1)
(while (setq view (tblnext "VIEW" (not view)))
(setq num (1+ num)
vlist (cons (cons num (cdr (assoc 2 view))) vlist) ) )
(prompt "\nNUMBER VIEW")
(prompt "\n------------\n")
(foreach item (reverse vlist)
(princ (car item))(princ (strcat " " (cdr item) "\n")) )
(while (and res (or (> 0 res)(< num res)))
(setq res (getint "\n View Number <0>: ")) )
(if res res 0) )
(defun asksun (/ vlist val)
;; set lighting parameters.
(foreach item '(("\n Hour <16.5>: " 16.5 T )
("\n Day <01>: " 01 NIL )
("\n Month <08>: " 08 NIL )
("\n Timezone <-1>: " -1 NIL )
("\n Latitude <47.5>: " 47.5 T )
("\nLongitude <-8.5>: " -8.5 T ) )
(if (null (setq val (if (last item)
(getreal (car item))
(getint (car item)) )))
(setq val (cadr item)) )
(setq vlist (cons (if (last item)(rtos val)(itoa val)) vlist)) )
vlist )
;;; SAMPLING SETUP ***********************************************************
(defun setradsamplemode (stdalone / samplemode)
;; set sorting criteria.
(if stdalone (torad_setup))
(initget "Layer Toplayer Color")
(setq samplemode *exportsmode*
samplemode (getkword (strcat "\n\ncollect data by Color/Layer/Toplayer <" samplemode ">: ") ) )
(if samplemode (setq *exportsmode* samplemode))
(if stdalone (torad_reset)) )
(defun setradnumsegs (stdalone / numsegs)
;; set arc smoothing.
(if stdalone (torad_setup))
(setq numsegs *exportnsegs*
numsegs (getint (strcat "\nNumber of segments for circles (arcs) <"
(itoa numsegs) ">: ") ) )
(if numsegs (setq *exportnsegs* numsegs))
(if stdalone (torad_reset)) )
;;; DIALOG BOX CALL FOR TORAD *************************************************
(defun torad_dlg (/ dcl_id typelist dwgname dwgprefix num view viewlist stat)
;; dialog box control for Autocad 12 and later (?).
(setq dwgname (getvar "dwgname")
dwgprefix (strcat (getvar "dwgprefix") "*")
num 0 )
(if (wcmatch dwgname dwgprefix)
(setq dwgname (strcat "./" (substr dwgname (strlen dwgprefix)))) )
;; load and execute dialog if possible.
(setq dcl_id (load_dialog "torad.dcl"))
(cond ( (> 0 dcl_id)
(alert "\nCouldn't load dialog!")
(setq stat -1))
( (not (new_dialog "radiance" dcl_id "" *toraddlgpos*))
(alert "\nCouldn't open dialog!")
(setq stat -1) )
(T
;; setup view list.
(start_list "viewlist" 3)
(add_list "current")
(while (setq view (tblnext "VIEW" (not view)))
(setq viewlist (cons (cons num view) viewlist)
num (1+ num) )
(add_list (cdadr view)) )
(end_list)
;; setup entity types
(mapcar '(lambda (item)
(set_tile (car item)
(if (member (car item) *toradtypelist*)
"1" "0" ) ) )
*toradetypes*)
;; setup filetypes section.
(mode_tile "viewlist" 1)
(mode_tile "sunvals" 1)
(mode_tile "masterblock" 1)
(mode_tile "prefix" 2)
;; setup default values.
(set_tile "prefix" dwgname)
(set_tile "make" "1")
(set_tile "nsegs" (itoa *exportnsegs*))
(set_tile "sample" *exportsmode*)
;; initialize callback functions.
(action_tile "files" "(toggle_files)")
(action_tile "master" "(toggle_master)")
(action_tile "light" "(toggle_light)")
(action_tile "view" "(toggle_view)")
(action_tile "prefix" "(torad_enddlg)")
(action_tile "accept" "(torad_enddlg)")
(action_tile "cancel" "(torad_candlg)")
;; go for it.
(setq stat (start_dialog))
(unload_dialog dcl_id)
))
stat )
(defun toggle_light ()
;; callback for sunlight toggle.
(cond ( (= "1" (get_tile "light"))
(mode_tile "sunvals" 0)
(mode_tile "long" 2) )
(T (mode_tile "sunvals" 1)
(mode_tile "prefix" 2) ) ) )
(defun toggle_master ()
;; calback for masterfile toggle.
(if (= "1" (get_tile "master"))
(mode_tile "masterblock" 0)
(mode_tile "masterblock" 1) ) )
(defun toggle_view ()
;; callback for viewfile toggle.
(if (= "1" (get_tile "view"))
(mode_tile "viewlist" 0)
(mode_tile "viewlist" 1) ) )
(defun toggle_files ()
;; callback for geometry files toggle.
(cond ( (= "1" (get_tile "files"))
(mode_tile "filelist" 0)
(mode_tile "modes" 0)
(mode_tile "auxf" 0)
(toggle_master) )
(T
(mode_tile "filelist" 1)
(mode_tile "modes" 1)
(mode_tile "auxf" 1) ) ) )
(defun torad_enddlg ()
;; callback for accepting dialog.
;; accepted if 'ok' or return in prefix field.
(cond ( (= 2 $reason) nil)
( T (getraddlgvalues)) ) )
(defun getraddlgvalues (/ home filelist lightlist typelist nmodl samplebase
prefix errval make lightval radtypelist samplemode east numsegs)
;; extract data if possible and close dialog box.
;; else give alert and stay.
(cond ( (= "1" (get_tile "files"))
(setq typelist *toradetypes*)
(mapcar '(lambda (item)
(if (= "1" (get_tile (car item)))
(setq nmodl (cons (car item) nmodl)) ) )
typelist )
(setq radtypelist nmodl
samplemode (get_tile "sample")
numsegs (read (get_tile "nsegs"))
filelist '(("files"))
samplebase '(("mat")("master")("make")("view")("light") ) ) )
(T (setq samplebase '(("view")("light"))) ) )
(mapcar '(lambda (item)
(if (= "1" (get_tile (car item)))
(setq filelist (cons item filelist)) ) )
samplebase )
(cond ( (assoc "master" filelist)
(setq east (read (get_tile "WCS rotation")))
(if (numberp east)
(setq filelist (subst (cons "master" east) '("master") filelist))
(setq errval "WCS rotation") ) )
(T (if (setq make (member '("make") filelist))
(setq filelist (append (cdr make)
(cdr (member '("make")
(reverse filelist))))) ) ) )
(cond ( (assoc "light" filelist)
(mapcar '(lambda (item)
(setq lightval (read (get_tile item)))
(if (numberp lightval)
(setq lightlist (cons (get_tile item) lightlist))
(setq errval item) ) )
'("Hour""Day""Month""TZ""Latitude""Longitude") )
(setq filelist (subst (cons "light" lightlist) '("light") filelist)) )
(T NIL) )
(if (assoc "view" filelist)
(setq filelist (subst (cons "view" (read (get_tile "viewlist")))
'("view") filelist) ) )
(setq prefix (get_tile "prefix"))
(if (and (= "~" (substr prefix 1 1))
(setq home (getenv "HOME")) )
(setq prefix (strcat home (substr prefix 2))) )
(setq filelist (cons (cons "prefix" prefix) filelist))
(cond ( (and numsegs (not (numberp numsegs)))
(mode_tile "nsegs" 2)
(mode_tile "nsegs" 3)
(alert "Please enter a NUMBER for \"Number of Segments\" !") )
( errval
(mode_tile errval 2)
(mode_tile errval 3)
(alert (strcat "Please enter a NUMBER for \"" errval "\" !")) )
(T (if numsegs (setq *exportnsegs* numsegs))
(if samplemode (setq *exportsmode* samplemode))
(if filelist (setq *toradfilelist* filelist))
(if radtypelist (setq *toradtypelist* radtypelist))
(setq *toraddlgpos* (done_dialog 1)) ) ) )
(defun torad_candlg ()
;; cancel button selected.
(setq *toraddlgpos* (done_dialog 0)) )
;;; WRITES ******************************************************************
(defun writerad (fname / lplist lay radname radfname radfile ename matlist)
;; open files for radiance geometry description.
(prompt "\nwriting out radiance-files:\n")
(foreach lplist *exportentlist*
(cond ( (cdr lplist)
(setq lay (strcase (strcat (if (= "Color" *exportsmode*)
"c_" "l_") (regulatename (car lplist)) ) T )
radname (strcat (noprefix fname) "_" lay)
radfname (strcat fname "_" lay ".rad") )
(cond ( (setq radfile (setq *FILE* (open radfname "w")))
(writeradlist fname lplist lay radname radfname radfile)
(setq matlist (cons (list lay radname radfname) matlist))
(close radfile)
(setq *FILE* NIL) )
( T (prompt "\nCan't open file \"" radfname
"\" for write! ") ) ) )
(T NIL) ) )
matlist )
(defun writeradlist (fname lplist lay radname radfname radfile
/ ename contele num numstep numtot polylist)
;; write radiance geometry description.
(princ (strcat "### Radiance scene-file: " radfname) radfile)
(princ (strcat "\n### Created: " (datestring)) radfile)
(princ "\n### TORAD.LSP by Georg Mischler\n\n" radfile)
(princ "### make sure material " radfile) (princ radname radfile)
(princ " is defined in a previous file!\n" radfile)
(princ "\n### polygons for object " radfile)
(princ radname radfile) (princ "\n" radfile)
(setq num 0
numtot (length lplist)
numstep 0 )
(while (> numtot numstep)
(prompt (strcat " file: " radfname " "
(itoa numstep) "/" (itoa numtot) " \r"))
(setq numstep (min (+ numstep 10) numtot))
(while (< num numstep)
(setq lplist (cdr lplist)
ename (car lplist)
num (1+ num) )
(if (listp ename)
(setq contele (reverse (cdr ename))
ename (car ename))
(setq contele nil) )
(writeradents ename contele radfile radname num) ) )
(prompt (strcat " file: " radfname " " (itoa numstep) " \n")) )
(defun writeradents (ename conte rfile radname num / typ data)
;; dispatch entities to extraction and write functions.
(if ename (setq data (entget ename)
TYP (getetype data) ))
(cond ( (valuablepoly typ)
(cond ( (equal typ "LINE")
(writeradpoly conte rfile radname num (linetopoly data)) )
( (equal typ "PLINE")
(writeradpoly conte rfile radname num
(plinetopoly data 1 *exportnsegs*)) )
( (equal typ "POLYGON")
(writeradpoly conte rfile radname num
(plinetopoly data 2 *exportnsegs*)) )
( (equal typ "WPLINE")
(writeradpoly conte rfile radname num
(plinetopoly data 3 *exportnsegs*)) )
( (equal typ "PMESH")
(writeradpoly conte rfile radname num (meshtopoly data)) )
( (equal typ "PFACE")
(writeradpoly conte rfile radname num (pfacetopoly data)) )
( (equal typ "3DFACE")
(writeradpoly conte rfile radname num (facetopoly data)) )
( (equal typ "TRACE")
(writeradpoly conte rfile radname num (tracetopoly data)) )
( (equal typ "SOLID")
(writeradpoly conte rfile radname num (tracetopoly data)) )
( (equal typ "CIRCLE")
(writeradcircle conte rfile radname num (circletorad data)) )
( (equal typ "ARC")
(writeradpoly conte rfile radname num
(arctopoly data *exportnsegs*)) )
( (equal typ "POINT")
(writeradpoint conte rfile radname num (pointtorad data)) )
(T NIL) ) )
( T NIL) ) )
(defun writeradpoly (contele radfile radname num polylist / len polnum)
;; write polygon lists to file.
(if contele (setq polylist (trans_back polylist contele)))
;(showpolylist polylist) ; visual debugging.
(setq polnum 0)
(foreach poly polylist
(cond ( (and poly (< 2 (setq len (length poly))))
(setq polnum (1+ polnum))
(princ (strcat "\n" radname " polygon " radname "."
(itoa num) "." (itoa polnum)) radfile )
(princ "\n0\n0\n" radfile)
(princ (* len 3) radfile)
(foreach pt poly (printradpoint pt radfile))
(princ "\n" radfile) )
(T nil) ) ) )
(defun writeradcircle (contele radfile radname num polylist / len rad typ xname)
;; write circles as rings cylinders or tubes.
(setq len (car polylist)
rad (cadr polylist)
xname (strcat radname "." (itoa num))
polylist (if contele (car (trans_back (caddr polylist) contele))
(caaddr polylist) ) )
(cond ( (= 0.0 len)
(princ (strcat "\n" radname " ring " xname "\n0\n0\n8") radfile)
(printradpoint (car polylist) radfile)
(printradpoint (vector (car polylist)(cadr polylist)) radfile)
(princ (strcat " 0 " (rtos rad) "\n" ) radfile) )
( T
(cond ( (> 0.0 len) (setq typ "tube"))
( T (setq typ "cylinder")) )
(princ (strcat "\n" radname " " typ " " xname ".1\n0\n0\n7") radfile)
(printradpoint (car polylist) radfile)
(printradpoint (cadr polylist) radfile)
(princ (strcat " " (rtos rad) "\n") radfile)
(princ (strcat "\n" radname " ring " xname ".2\n0\n0\n8") radfile)
(printradpoint (cadr polylist) radfile)
(printradpoint (vector (car polylist)(cadr polylist)) radfile)
(princ (strcat " 0 " (rtos rad) "\n" ) radfile)
(princ (strcat "\n" radname " ring " xname ".3\n0\n0\n8") radfile)
(printradpoint (car polylist) radfile)
(printradpoint (vector (cadr polylist)(car polylist)) radfile)
(princ (strcat " 0 " (rtos rad) "\n" ) radfile) ) ) )
(defun writeradpoint (conte rfile rname num polylist / center radius typ xname)
;; write point entities to file as spheres or bubbles.
(setq radius (car polylist))
(if (= 0.0 radius) (setq radius (getvar "PDSIZE")))
(cond ( (= 0.0 radius) NIL)
( (< 0.0 radius) (setq typ "sphere"))
( (> 0.0 radius) (setq typ "bubble")) )
(cond ( typ
(setq xname (strcat rname "." (itoa num))
center (caar (if conte
(trans_back (cadr polylist) conte)
(cadr polylist) ))
)
(princ (strcat "\n" rname " " typ " " xname "\n0\n0\n4") rfile)
(printradpoint center rfile)
(princ (strcat " " (rtos radius) "\n") rfile) ) ) )
(defun printradpoint (point radfile)
;; write a single vertex to file.
(foreach number point
(princ " " radfile)
(princ (shortnumstr number 11) radfile) )
(princ "\n" radfile) )
;;; WRITE ADDITIONAL CONTROL INFORMATION ************************************
(defun writeradsun (fname sun / sunfname sfname sunfile)
;; write a file containing a description of natural lighting.
;; generate a call to gensky and the source for the sky for time and place.
(setq sunfname (strcat fname ".sun")
sfname (noprefix sunfname) )
(cond ( (setq sunfile (setq *FILE* (open sunfname "w")))
(princ (strcat "\nCreating sun-file: " sunfname))
(princ (strcat "### Radiance Sun-definition-file: " sfname) sunfile)
(princ (strcat "\n### Created: " (datestring)) sunfile)
(princ "\n### TORAD.LSP by Georg Mischler\n" sunfile)
(princ "\n### Sun and sky definition at:" sunfile)
(princ (strcat "\n### Longitude: " (nth 0 sun)) sunfile)
(princ (strcat "\n### Latitude: " (nth 1 sun)) sunfile)
(princ (strcat "\n### Timezone: " (nth 2 sun)) sunfile)
(princ (strcat "\n### Month: " (nth 3 sun)) sunfile)
(princ (strcat "\n### Day: " (nth 4 sun)) sunfile)
(princ (strcat "\n### Hour: " (nth 5 sun)) sunfile)
(princ "\n\n!gensky " sunfile)
(princ (strcat (nth 3 sun) " " (nth 4 sun) " " (nth 5 sun)) sunfile)
(princ (strcat " -o " (car sun) " -a " (cadr sun)) sunfile)
(princ (strcat " -m " (rtos (* 15 (read (caddr sun)))) "\n") sunfile)
(princ "\nskyfunc glow skyglow\n0\n0\n4 0.9 0.9 1 0\n" sunfile)
(princ "\nskyglow source sky\n0\n0\n4 0 0 1 180\n" sunfile) )
(T (princ (strcat "\nCan't open material-file " sunfname
" for write."))) ) )
(defun writeradmatlist (fname matlist / matfname matfile sfname)
;; write a list of materials from the used modifier names.
;; materials are all plastic of a constant grey.
(setq matfname (strcat fname ".mat")
sfname (noprefix fname) )
(cond ( (setq matfile (setq *FILE* (open matfname "w")))
(princ (strcat "\nCreating material-file: " matfname))
(princ (strcat "### Radiance material-file: " sfname ".mat") matfile)
(princ (strcat "\n### Created: " (datestring)) matfile)
(princ "\n### TORAD.LSP by Georg Mischler\n\n" matfile)
(foreach mat matlist
(princ (strcat "\nvoid plastic " (cadr mat)) matfile)
(princ "\n0\n0\n5 0.65 0.65 0.65 0.0 0.0\n" matfile)
)
(close matfile)
(setq *FILE* NIL) )
(T (princ (strcat "\nCan't open material-file " matfname
" for write." ))) ) )
(defun writeradtot (fname erot matlist / totfname totfile sfname infunc)
;; write a controlling master file to combine all the written data
;; into a complete RADIANCE scene description.
(setq totfname (strcat fname ".rad")
sfname (noprefix fname)
infunc (if (/= 0.0 erot)
(strcat "\n!xform -rz " (rtos erot) " ")
"\n!cat " ) )
(cond ( (setq totfile (setq *FILE* (open totfname "w")))
(princ (strcat "\nCreating Master-file: " totfname))
(princ (strcat "### Radiance Master-file: " sfname ".rad") totfile)
(princ (strcat "\n### Created: " (datestring)) totfile)
(princ "\n### TORAD.LSP by Georg Mischler\n\n" totfile)
(if (assoc "light" *toradfilelist*)
(princ (strcat infunc sfname ".sun\n\n") totfile) )
(if (assoc "mat" *toradfilelist*)
(princ (strcat "!cat " sfname ".mat\n\n") totfile) )
(foreach mat matlist
(princ (strcat "!cat " (cadr mat) ".rad\n" ) totfile) )
(close totfile)
(setq *FILE* NIL) )
(T (princ (strcat "\nCan't open Master-file "
totfname " for write.") )) ) )
(defun writeradview (fname viewnum / viewfname vdir vpoint vmode target
lensl twist zvect vsize vlist viewfile)
;; write a RADIANCE viewfile either from the current view or
;; from a named view from the view table.
(setq viewfname (strcat fname ".view"))
(cond ( (= 0 viewnum)
(setq vdir (trans (getvar "VIEWDIR") 1 0 T)
vmode (getvar "VIEWMODE")
target (if (= 0 vmode)(getvar "VIEWCTR")(getvar "TARGET"))
vpoint (transl-p (trans target 1 0 T) vdir 1.0)
lensl (getvar "LENSLENGTH")
twist (getvar "VIEWTWIST")
zvect (trans '(0.0 1.0 0.0) 2 0 T) ) )
(T
(repeat viewnum (setq vlist (tblnext "VIEW" (not vlist))) )
(setq vdir (cdr (assoc 11 vlist))
vmode (cdr (assoc 71 vlist))
target (cdr (if (= 0 vmode) ; keep it simple...
(append (mapcar '+ (assoc 10 vlist)
(assoc 12 vlist) )'(0.0))
(assoc 12 vlist) ))
vpoint (transl-p target vdir 1.0)
lensl (cdr (assoc 42 vlist))
twist (cdr (assoc 50 vlist))
zvect (vect-prod '(0.0 0.0 1.0) vdir)
zvect (if (equal '(0.0 0.0 0.0) zvect 0.0000001)
'(0.0 0.1 0.0)
(vect-prod vdir zvect) ) ) ) )
(if (= 0 vmode)
(setq vsize (rtos (getvar "VIEWSIZE")))
(setq vsize (rtos (/ (* 360 (atan (/ 12.0 lensl))) pi))) )
(setq vdir (mapcar '- vdir))
(if (and (< 0 viewnum) (/= 0.0 twist))
(setq zvect (transf-p zvect (rot-3d-matrix (normalize vdir) twist))) )
(if (and (< 0.7 (caddr zvect))(= 0.0 twist))
(setq zvect '(0.0 0.0 1.0)) )
(cond ( (setq viewfile (setq *FILE* (open viewfname "w")))
(princ (strcat "\nCreating View-file: " fname ".view"))
(princ "rview -vt" viewfile)
(princ (if (= 1 vmode) "v -vp " "l -vp ") viewfile)
(mapcar '(lambda (pt) (princ (strcat (rtos pt) " ") viewfile)) vpoint )
(princ " -vd " viewfile)
(mapcar '(lambda (pt) (princ (strcat (rtos pt) " ") viewfile)) vdir)
(princ " -vu " viewfile)
(mapcar '(lambda (pt) (princ (strcat (rtos pt) " ") viewfile)) zvect )
(princ (strcat " -vh " vsize " -vv " vsize " -vs 0 -vl 0\n") viewfile)
(close viewfile)
(setq *FILE* NIL) )
(T (princ (strcat "\nCan't open view-file "
viewfname " for write." ))) ) )
(defun writeradmake (fname matlist / makefname makefile sfname)
;; write a makefile for the UNIX utility make containing rules for
;; octree conversion, previewing with rview and batch rendering with rpict.
(setq sfname (noprefix fname)
makefname (strcat (substr fname 1 (- (strlen fname)
(strlen sfname))) "makefile" ) )
(cond ( (setq makefile (setq *FILE* (open makefname "w")))
(princ (strcat "\nCreating makefile: " makefname))
(princ (strcat "### makefile for Radiance-file: "sfname".rad")makefile) (princ (strcat "\n### Created: " (datestring)) makefile)
(princ "\n### TORAD.LSP by Georg Mischler\n\n" makefile)
(princ "\nall:\n\t at echo \" make what?\"" makefile)
(princ "\n\t at echo \" enter \\\"make view\\\" or \\\"make pict\\\"\"\n" makefile)
(princ (strcat "\nview:" sfname ".oct") makefile)
(princ (strcat "\n\trview -ab 2 -vf " sfname".view "
sfname".oct &\n")makefile)
(princ (strcat "\npict:" sfname ".oct") makefile)
(princ (strcat "\n\trpict -ab 2 -vf " sfname".view "
sfname".oct > " sfname ".pic &\n")makefile)
(princ (strcat "\n" sfname ".oct: ") makefile)
(princ (strcat " \\\n " sfname ".rad ") makefile)
(foreach mat matlist
(princ (strcat " \\\n " (cadr mat) ".rad") makefile))
(princ (strcat "\n\toconv "sfname".rad > "sfname".oct\n") makefile)
(princ (strcat "\nclean:\n\t @rm " sfname".oct\n") makefile)
(close makefile)
(setq *FILE* NIL) )
(T (princ (strcat "\nCan't open makefile "
makefname " for write." ))) ) )
;;; ***************************************************************************
(defun regulatename (name / pos char)
;; eliminate illegal characters in filenames.
(setq pos 1)
(repeat (strlen name)
(setq char (substr name pos 1))
(if (or (= char "|")(= char "$"))
(setq name (strcat (substr name 1 (1- pos))
"_"
(substr name (1+ pos)))))
(setq pos (1+ pos)) )
name )
;;;-----------------------------------------------------------------------------
(defun circletorad (data / center1 center2 radius dist plist)
;; extract a description of a circle for 'writeradcircle'.
(setq center1 (cdr (assoc 10 data))
radius (cdr (assoc 40 data))
dist (cdr (assoc 39 data))
center2 (list (car center1)(cadr center1)
(+ (caddr center1) (if dist dist 1.0)) )
plist (trans_back (list (List center2 center1))
(list (cdr (assoc -1 data)))) )
(list (if dist dist 0.0) radius plist) )
;;;-----------------------------------------------------------------------------
(defun pointtorad (data / center rad)
;; extract a description of a point for 'writeradpoint'.
(setq center (cdr (assoc 10 data))
rad (cdr (assoc 39 data))
rad (if (and rad (/= 0.0 rad)) rad 0.0) )
(list rad (list (list center))) )
;;; ***************************************************************************
(progn
(prompt "\n-- TORAD.LSP - 1993 by Georg Mischler --\n")
(prompt "\n Enter \"TORAD\" for writing Radiance files.")
(torad_reset) )
;;; ***************************************************************************
;;; end of torad.lsp.
;;; ***************************************************************************
[{--Wm. Tao & Associates, Inc.--}] This message and content is privileged, intended only for recipients named and/or addressed. If the receiver/reader is not a representative of the intended recipient, any review, forwarding, dissemination or copying of this message or its content, in part or in whole, is prohibited. If you have received this message in error, please notify the sender immediately by Reply email, and Delete the original message and attachments.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://radiance-online.org/pipermail/radiance-general/attachments/20100805/1c1586ff/attachment-0001.html
More information about the Radiance-general
mailing list