Category : Graphic Animations - Lots of older FLI's
Archive   : AFLIX.ZIP
Filename : AFKINET.LSP

 
Output of file : AFKINET.LSP contained in archive : AFLIX.ZIP

;
; Generate cameras and scenes to
; perform kinetic animation.
;
; Last updated in release 1.0a
;
; Designed and implemented by Kelvin R. Throop in May of 1987.
;
; This command takes a polyline, specifying the path and eye
; height (from the polyline's elevation), and generates cameras
; and scenes to walk through the model along the polyline. It
; simultaneously writes an AutoShade script file to generate
; the images for each frame, and an AutoFlix command file
; to create a movie from the frame images. The camera's look-at
; point can either be fixed or can be specified by a second
; polyline, allowing either examination of a fixed point
; from different viewpoints or a true Steadicam-type walkthrough.
; In addition, the camera may be smoothly twisted throughout
; the walkthough, permitting inspection from various angles.
;
; The generated script normally uses full shading to make the
; images. To change this to fast shading, or to subsequently
; change back to full shade, use the command SHADETYPE.
;

(setq shadecmd "fullshade")
(setq flixver "1.0a")

; SHADETYPE command. Permits user to select fast or full shaded
; renderings for animation frames.

(defun C:shadetype ()
(setq prcd T)
(while prcd
(setq s (strcase (substr (getstring (strcat "\nFast shading for images? <"
(if (= shadecmd "fastshade") "Y" "N")
">: ")) 1 1)))
(cond
((= (strlen s) 0) (setq prcd nil))
((= s "Y") (setq prcd nil shadecmd "fastshade"))
((= s "N") (setq prcd nil shadecmd "fullshade"))
)
)
(princ)
)

; Construct item name from type code B, base name, and index N

(defun cname (b n)
(strcat b bname (itoa n))
)

; ICL -- Insert camera or light. Presently used only for cameras

(defun icl (blkn lfxy laxy sname / scale slayer rot)
(setq scale (/ (getvar "VIEWSIZE") 9.52381))
(setq rot (* (/ 180 pi) (- (angle lfxy laxy) 1.570796)))
(command
"insert"
blkn
lfxy
scale
scale
(strcat "<<" (rtos rot 2 6))
sname ; SNAME
" " ; GNAME
(rtos (car laxy) 2 6) ; LAX
(rtos (cadr laxy) 2 6) ; LAY
(rtos (caddr laxy) 2 6) ; LAZ
)
)

; ISH -- Insert scene/set/shot/whatever the heck we're calling it today

(defun ish (sname otype oname / omode slayer)
(command
"insert"
"shot"
(list '2 '2)
1 ; No x scaling
1 ; No y scaling
"<<0" ; No rotation
otype ; Object type
oname ; Object name
sname ; Scene name
)
)

; SLOB Select Object

; Selects one of the active object types.
; Won't take NULL for an answer.

; Input: prefix prompt
; postfix prompt
; Null pick ok flag

; Uses global objct

; Return: entity

(defun slob (pre post nulok / prcd)

(setq prcd 1)

; Select the object to update.

(while (= 1 prcd)
(setq ename (car (entsel (strcat pre (strcase objct t) post))))
(if ename
(if (= (cdr (assoc '0 (setq elist (entget ename)))) "INSERT")
(progn
(setq bnam (cdr (assoc '2 elist)))
(cond
; Inserted block must have the desired object name.
((or
(= objct bnam)
(and (= bnam "DIRECT") (= objct "LIGHT"))
(and (= bnam "OVERHEAD") (= objct "LIGHT"))
(and (= bnam "SHOT") (= objct "SCENE")))
(setq prcd nil)
)
(T
(prompt (strcat "\nSelected object is not a "
(strcase objct t) " \n")))
)
)
)
(if nulok
(setq prcd nil))
)
)
ename
)

; bget (ename)

; Starting at ENAME entity name it searches the database for an SEQEND
; entity . The following list is returned:

; (elist0 elist1 elist2 ... elistN), where

; elist0 Is the block's entity list

; elist, i=1,N are the entities lists of the block's attributes

; If the desired INSERT entity is not found nil is returned

; Input: ename - Where to start the search.

; Return: blist - A global value

(defun bget ( ename / prcd elist)

(setq prcd 1)

; Before starting, see if the current blist contains
; the desired entity.

(cond
((and (listp 'blist) (= ename (cdr (assoc '-1 (car blist)))))
(ename))

(T
(setq blist (list (entget ename)))
(while prcd
(setq elist (entget (setq ename (entnext ename))))
(if (= (cdr (assoc '0 elist)) "SEQEND")
(setq prcd nil)
(setq blist (append blist (list elist)))
)
)
(cdr (assoc '-1 (car blist)))
)
)
)

; eget ( tagn )

; Searches the current blist for an ATTRIB elist whith an attribute
; tag equal to the argument's tag name. It returns either the
; attribute's elist or nil.

; Input: tagn - The attribute tag name
; blist - A global list containning the elists to be
; searched.
;
; Return: elist - The desired entity list or nil

(defun eget ( tagn / elist wlist)

(setq elist nil)
(foreach wlist blist
(if (and (= (cdr (assoc '0 wlist)) "ATTRIB")
(= (cdr (assoc '2 wlist)) tagn)
)
(setq elist wlist)
)
)
elist
)

; GETZ -- Obtain elevation defaulting to current elevation

(defun getz (s / z)
(setq z (getreal (strcat s " elevation <"
(rtos (getvar "elevation")) ">: ")))
(if (null z)
(setq z (getvar "elevation"))
)
z
)

; DIVPL -- Divide polyline into n animation steps. One
; step is placed at the start and one at the
; end of the polyline, and n - 2 in the middle.
; For historical reasons, DIVPL is called with
; 1 one greater than the number of points desired.

(defun divpl (p n / e op)
(if (setq op (= 0 (logand 1 (cdr (assoc 70 (entget (car p)))))))
(command "point" (cdr (assoc 10 (entget (entnext (car p))))))
)
(command "divide" p (- n (if op 2 1)))
(if op (progn
(setq e (car p))
(while (/= "SEQEND" (cdr (assoc 0 (entget (entnext e)))))
(setq e (entnext e))
)
(command "point" (cdr (assoc 10 (entget e))))
))
)

; ANIMLENS -- Specify nonstandard lens focal length for kinetic
; animation. Causes ANIMATE to generate a "lens"
; script command for every frame.

(setq animlens nil)
(defun C:animlens ()
(setq animlens nil)
(initget (+ 2 4))
(setq animlens
(getreal "\nAnimation lens focal length in mm <50>: "))
(princ)
)

; ANIMATE -- Kinetic animation command. Writes one filmroll
; per frame.


(defun C:animate ()
(setq prcd t)
(while prcd
(setq e (entsel "Choose camera path polyline: "))
(if (and e (= (cdr (assoc 0 (entget (car e)))) "POLYLINE"))
(setq prcd nil)
(princ "\nThat is not a polyline!\n")
)
)
(setq ep nil)
(initget (+ 1 8 16) "Path Same")
(setq samef nil)
(setq laxy (getpoint "\nChoose look-at point (or Path or Same): "))
(if (= laxy "Path")
(progn
(setq prcd t)
(while prcd
(setq ep (entsel "\nChoose look-at path polyline: "))
(if (and ep
(= (cdr (assoc 0 (entget (car ep)))) "POLYLINE"))
(setq prcd nil)
(princ "\nThat is not a polyline!\n")
)
)
(setq piz (getz "\nInitial path"))
(setq pfz (getz "\nFinal path"))
)
(if (= laxy "Same")
(setq samef t)
)
)

(setq llist nil bname nil)
(while (null bname)
(setq bname (getstring "\nBase name for path (1-3 characters): "))
(if (or (< (strlen bname) 1) (> (strlen bname) 3))
(progn
(princ
"Base name null or too long. Must be 1 to 3 characters.\n")
(setq bname nil)
)
)
)
(initget (+ 1 2 4))
(setq np (getint "\nNumber of frames: "))
(if (< np 3)
(progn
(setq np 3)
(princ "Frames set to minimum: 3\n")
)
)
(setq iz (getz "\nInitial camera"))
(setq fz (getz "\nFinal camera"))
(setq twist (getreal "\nTwist revolutions <0>: "))
(setq motl nil motrot nil motzt nil prcd t)
(while prcd
(if (> (strlen (setq ml (getstring "\nLayer to move: "))) 0)
(progn
(if (and (tblsearch "layer" ml) (ssget "X"
(list (cons 8 ml))))
(progn
(setq prcd1 t)
(while prcd1
(setq mlp (entsel (strcat
"\nChoose motion path polyline for " ml ": ")))
(if (and mlp
(= (cdr (assoc 0 (entget
(car mlp)))) "POLYLINE"))
(setq prcd1 nil)
(princ "\nThat is not a polyline!\n")
)
)
(setq motl (append motl (list (list ml mlp))))
(if (setq mrz (getreal "\nRotations <0>: "))
(setq motrot (append motrot (list
(/ (* 360.0 mrz) np))))
(setq motrot (append motrot '(0)))
)
(if (setq mrz (getreal "\nZ translation <0>: "))
(setq motzt (append motzt (list
(/ mrz np))))
(setq motzt (append motzt '(0)))
)
)
(prompt "No such layer in drawing or layer empty.\n")
)
)
(setq prcd nil)
)
)

; Acquire the names of the lights to be used in this picture
; by letting the user select them.

(setq objct "LIGHT")
(while (or (null llist) lname)
(setq lname (slob "\nSelect a " ": " T))

; Include the light name in the list of
; objects which belong to the scene. Don't
; do it if the light is already part of the
; scene.

(if lname
(progn
(bget lname)
(setq lname (cdr (assoc '1 (eget "SNAME"))))
(prompt (strcat " " lname "\n"))
(if (not (member lname llist))
(setq
llist (cons lname llist)
)
(prompt (strcat "\nLight " lname " already selected.\n"))
)
)
)
)

(setvar "CMDECHO" 0)
(setq blippo (getvar "BLIPMODE"))
(setvar "BLIPMODE" 0)

(setq slayer (getvar "CLAYER"))
(command "LAYER" "MAKE" "$$DOTS" "")
(command "point" '(0 0))
(setq np (1+ np))
(setq ss (entlast))
(divpl e np)
(if ep
(progn
(setq ssep (entlast))
(divpl ep np)
)
)

; Now walk through the motion layer list and create division
; points on the polylines that trace object motion.

(setq pernt 0 motp nil)
(while (< pernt (length motl))
(setq motp (append motp (list (entlast))))
(divpl (cadr (nth pernt motl)) np)
; Sledgehammer to put all objects back at original position
; at the end. Admire, but don't emulate.
(command "point" (cdr (assoc 10 (entget
(entnext (nth pernt motp))))))
(setq pernt (1+ pernt))
)

(command "LAYER" "MAKE" "$$ANICAM" "")

; Now walk through the polyline and generate a camera and
; a set containing it and every light named, all pointing to
; the desired look-at point.

(setq asf (open (strcat bname ".scr") "w"))
(setq mvf (open (strcat bname ".mvi") "w"))
(write-line "record on" asf)

(setq pernt 1)
(setq e el)
(setq tangle 0.0)
(while (< pernt np)
(setq en (setq ss (entnext ss)))
(setq pelev (+ iz (* (- fz iz)
(/ (- pernt 1.0) (- np 2.0)))))
(if ep
(progn
(setq laxy (append (cdr (assoc 10 (entget
(setq ssep (entnext ssep)))))
(list (+ piz (* (- pfz piz)
(/ (- pernt 1.0) (- np 2.0)))))))
)
)

; If look at path is same as camera path, constantly look at
; next point (and at end, look from next to last to last
; direction from the last point).

(if samef
(progn
(if (< pernt (1- np))
(setq
plaxy laxy
laxy (append (cdr (assoc 10 (entget (entnext en))))
(list (+ iz (* (- fz iz)
(/ pernt (- np 2.0))))))
)
(progn
(setq cpxy (append (cdr (assoc 10 (entget en)))
(list pelev)))
(setq laxy (mapcar '+ cpxy
(mapcar '- cpxy plaxy))
)
)
)
)
)
(icl "camera" (append (cdr (assoc 10 (entget en))) (list pelev))
laxy (setq tcn (cname "C" pernt))
)
(ish (setq tsn (cname "S" pernt)) "CAMERA" tcn)
(setq ll llist)
(while ll
(ish tsn "LIGHT" (car ll))
(setq ll (cdr ll))
)
(setq usn (cname "s" pernt))
(write-line (strcat "open" " " usn) asf)
(write-line (strcat "scene " usn) asf)
(write-line "spercent -1" asf)
(if animlens
(write-line (strcat "lens " (rtos animlens 2 6)) asf)
)
(if twist
(progn
(write-line (strcat "twist " (rtos tangle 2 6)) asf)
(setq tangle (rem (+ tangle (/ (* 360.0 twist) (- np 2.0)))
360.0))
)
)
(command "filmroll" usn)
; Get rid of camera and scene
(command "erase" (ssget "X" '((8 . "$$ANICAM"))) "")
(write-line (strcat shadecmd " " usn) asf)
(write-line usn mvf)

; Move everything into position for the next frame

(setq motn 0 motu nil)
(while (< motn (length motl))
(setq me (entnext (nth motn motp)))
(command "move" (ssget "X" (list (cons 8
(car (nth motn motl))))) ""
(append (cdr (assoc 10 (entget me))) (list 0.0))
(append (setq motbp (cdr (assoc 10 (entget (entnext me)))))
(list (nth motn motzt)))
)
(setq motu (append motu (list me)))
(if (/= 0 (setq motor (nth motn motrot)))
(command "rotate" (ssget "X" (list (cons 8
(car (nth motn motl))))) ""
motbp
(strcat "<<" (rtos motor 2 6))
)
)
(setq motn (1+ motn))
)
(setq motp motu)

(setq pernt (1+ pernt))
)

; Reverse rotation and Z translation for moving objects

(setq motn 0)
(while (< motn (length motl))
(setq me (entnext (nth motn motp)))
(command "move" (ssget "X" (list (cons 8
(car (nth motn motl))))) ""
(append (cdr (assoc 10 (entget me))) (list 0.0))
(append (setq motbp (cdr (assoc 10 (entget me))))
(list (* -1 (- np 1) (nth motn motzt))))
)
(setq motu (append motu (list me)))
(if (/= 0 (setq motor (nth motn motrot)))
(command "rotate" (ssget "X" (list (cons 8
(car (nth motn motl))))) ""
motbp
(strcat "<<" (rtos (* -1 (- np 1) motor) 2 6))
)
)
(setq motn (1+ motn))
)

(close asf)
(close mvf)
(command "erase" (ssget "X" '((8 . "$$DOTS"))) "")
(command "LAYER" "SET" slayer "")
(setvar "BLIPMODE" blippo)
(setvar "CMDECHO" 1)
(princ)
)