home *** CD-ROM | disk | FTP | other *** search
- ;;;*********************************************************************;;; PTOOLS.lsp 1.01;;; Copyright (C) 1990 by Autodesk, Inc.;;; ;;; Permission to use, copy, modify, and distribute this software and its;;; documentation for any purpose and without fee is hereby granted. ;;;;;; 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.;;; ;;; ATK support functions and commands for use with ;;; PATH.lsp, KINETIC.lsp, BLOCKIT.lsp;;; ;;; Designed and implemented by Jamie Clay in June of 1990;;; Reformatted file for compliance with coding standards. ;;; JSY -- Sept. 1990;;; ;;;*********************************************************************;;;;;; Commands: ATKEdit - edit the ATKSetup block;;; ATKSetup - Insert the ATKSetup block;;; Preview - Preview an AutoShade Script;;; PTSmark - Tool for displaying frame numbers/postion ;;; PTSout - Creates a ATK point list from PTSmark numbers;;; RevPoly - Reverses the direction of a polyline;;; SLDview - Makes slide files from AutoShade scripts;;;;;;;;;*********************************************************************;;;;;; Support ;;; Functions: Read the ATKSetup block;;; (atkread x) x = entity name;;;;;; Reset invalid ATKSetup values;;; (atkreset x y) x = string, y = new setting;;;;;; ATK *error* function;;; (*close* x) x = error message;;;;;; File name/numbering function;;; (cname x y) x = string, y = integer;;;;;; Search a string for a comma;;; (comma x) x = string;;;;;; Divide a polyline and create a point list;;; (gather x y) x = polyline, y = integer;;;;;; Return an association within an entity list;;; (getass x y) x = integer, y = entity name;;;;;; Check for valid file name;;; (getname x) x = prompt string ;;; ;;; Find current storage directory ;;; (getdir) ;;;;;; Return a string without the directory prefix;;; (justname x) x = file name string;;;;;; Collet motion step information;;; (motion_steps);;;;;; Set type of output for kinetic processes;;; (output);;;;;; Calculate point distances along a polyline;;; (plen x y) x = polyline, y = integer;;;;;; Check entity to see if it's a valid polyline;;; (polytest x) x = entity to check;;;;;; Read points in from a specified file;;; (ptsread x) x = file to read;;;;;; Create and update .MVI and .BLT support files;;; (supfile x y) x = integer, y = file name;;;;;; View a sequence of scenes from an open file;;; (view file) x = file pointer;;;;;;*********************************************************************(if (not loaded) (princ "\nLoading ..."))(vmon);;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; COMMANDS * ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ATKUpdate -- simple little command for updating the ATKSetup block;;;(defun c:atkupdate (/ oce) (setq *olderror* *error* *error* *close* ) (setq oce (getvar "cmdecho")) (setvar "cmdecho" 0) (setq atkblk (ssget "x" '((2 . "ATKSETUP")))) (command "erase" atkblk "" "insert" "atksetup=atksetup" "\03" ) ;; (command) ; This stops scripts!! (c:atksetup) (setvar "cmdecho" oce) (setq *error* *olderror*) (princ)) ;;;;;; ATKEdit -- command to allow editing of ATK block;;;(defun c:ATKEDIT (/ oce) (setq *olderror* *error* *error* *close* ) (setq oce (getvar "cmdecho")) (setvar "cmdecho" 0) (setq atkblk (ssget "x" '((2 . "ATKSETUP")))) (if atkblk (progn (if (> (sslength atkblk) 1) (progn (setq atkblk nil) (while (not atkblk) (setq atkblk (car (entsel "\nPlease select ATK Setup to edit: ") ) ) (if atkblk (if (/= "ATKSETUP" (cdr (assoc 2 (entget atkblk)))) (setq atkblk nil) ) ) ) ) (setq atkblk (ssname atkblk 0)) ) (command "ddatte" atkblk) (atkread atkblk) ) ) (setvar "cmdecho" oce) (setq *error* *olderror*) (princ));;;;;; ATKSetup -- command for the insertion of the ATKSETUP.dwg block.;;;(defun c:ATKSETUP (/ oce texteval) (setq *olderror* *error* *error* *close* texteval (getvar "texteval") ) (setq oce (getvar "cmdecho")) (setq attreq (getvar "attreq")) (setvar "attreq" 1) (setvar "cmdecho" 0) (setvar "texteval" 1) (setq ribname (ssget "x" '((2 . "RM_RCB")))) (if ribname (setq ribname (cdr (assoc 1 (entget (entnext (ssname ribname 0))))) sht "RenderMan" ) (setq ribname "None" sht "" ) ) (setq scene (ssget "x" '((2 . "CLAPPER")))) (if scene (setq scene (cdr (assoc 1 (entget (entnext (ssname scene 0)))))) (setq scene "") ) (if (not fdir) (setq fdir (getvar "dwgprefix")) ) (initget 1) (setq atkname (getstring "\nATK Setup name: ")) (initget 1) (setq inspt (getpoint "\nATK Setup location: ")) (command "insert" "atksetup" ; block name inspt ; insertion point (/ (getvar "viewsize") 10.0) ;block scale "" "" ; Y=X, No rotation atkname ; user supplied name fdir ; Fdir value (getvar "dwgname") ; Filmroll title scene ; Scene to use "" ; lens "" ; twist "" ; intersection "" ; Smooth shade "" ; background color number sht ; Shade type "" ; Record toggle ribname ; RSB block name "" ; Destination "" ; Render res and aspect ratio "" ; pixel samples "" ; Shadow switches ) (command "ddatte" (entlast)) (atkread (entlast)) (setvar "cmdecho" oce) (setvar "texteval" texteval) (setvar "attreq" attreq) (setq *error* *olderror*) (princ));;;;;; C:PLENGTH -- Measures both total and segment lengths of a polyline.;;;(defun c:plength (/ pline div) (setq *olderror* *error* *error* *close* ) (while (not pline) ;;get a polyline to process (setq pline (entsel "\nSelect a polyline: " )) (setq pline (polytest pline)) ) (while (not div) (initget 7) (setq div (getint "\nNumber of frames: ")) (if (< div 3) (setq div nil) ) ) (plen pline div);;process the pline (princ (strcat "\nSingle segment length for "(itoa div)" frames = ")) (princ (distance pt1 pt2)) (princ "\nTotal length = ") (princ total) (redraw) (setq *error* *olderror*) (princ));;;;;; C:PTSmark -- A command used to display animation path information.;;; PTSmark will create layer PATH_NUMBERS and place generated;;; numbers on this layer in the color of the selected polyline.;;; PTSMark will also (grdraw) a line between coincidal points ;;; along the first selected polyline and a second polyline or ;;; fixed point.;;;(defun c:ptsmark (/ 1st 2nd numbers pt2 points points2 pline pline2 s#) (setq *olderror* *error* *error* *close* index 1 ) (if (not fdir) (getdir)) ; get the directory info (while (not s#) (initget 7) (setq s# (getint "\nNumber of frames: ")) (if (< s# 3) (progn (setq s# nil) (prompt "\nPlease enter a larger number.") ) ) ) (while (not 1st) (initget "Pline List") (setq 1st (getkword "\nFirst path>> Pline/List <Pline>: ")) (cond ((or (not 1st) (= 1st "Pline")) (setq pline (entsel "\nSelect a polyline: ") pline (polytest pline) 1st "Pline" ) (redraw (car pline) 3);;highlight the most selected ployline ) (T (while (not points) (setq points (getstring "\nFile name: ") points (ptsread points) s# txtpt# ) ) ) ) ) (if (not points) (setq points (gather pline s#)) ) (initget "Pline Fixed List None") (setq 2nd (getkword "\nSecond path>> Pline/Fixed/List <none>: ")) (if (= 2nd "None") (setq 2nd nil)) (if 2nd (cond ((= 2nd "Pline") (while (not pline2) (setq pline2 (entsel "\nSelect a polyline: ")) (setq pline2 (polytest pline2)) (if pline2 (redraw (car pline2) 3)) ) ) ((= 2nd "Fixed") (initget 1) (setq pt2 (getpoint "\nPick a point: ")) ) (T (while (not points2) (setq points2 (getstring "\nFile name: ")) (setq points2 (ptsread points2)) ) ) ) ) (initget "Yes No") (if (/= 1st "List") (if (or pline2 pt2 points2) (setq numbers (getkword "\nShow numbers? <N>: ")) (setq numbers T) ) (setq numbers nil) ) (if (= numbers "No") (setq numbers nil)) (setq oce (getvar "cmdecho")) (setvar "cmdecho" 0) (if pline2 (setq points2 (gather pline2 s#)) ) (if numbers ; set up for numbers if requested (progn (setq tsize (/ (getvar "viewsize") 30)) ; get a basic text size ;;See if they want a different size (setq ts (getdist (strcat "\nText size <" (rtos tsize) ">:"))) (if ts (setq tsize ts)) (setq ccolor (getvar "ccolor")) ;save current color (setq layer (getvar "clayer")) ;save current layer ;;set current color to entity color (command "color" (cdr (assoc 62 (entget (car pline))))) ;;check to see if layer is there already (if (tblsearch "layer" "path_numbers") (command "layer" "t" "path_numbers" "s" "path_numbers" "") (command "layer" "m" "path_numbers" "") ) ;;set text size to 0 so new size can be applied (command "style" "" "" "0" "" "" "" "" "") (command "ucs" "V") ; switch ucs to curent view ) ) (setq num s#) (redraw) ; clean the screen of any previous stuff (repeat (length points) ;start the process (setq pt (trans (nth (1- s#) points) 0 1)) ;convert the points (if numbers ;;create numbers if asked for (command "text" "C" pt tsize "" (itoa num)) ) (if (or points2 pt2) (progn (if points2 (setq pt2 (trans (nth (1- s#) points2) 0 1)) ) (if red (progn (grdraw pt pt2 1) (setq red nil)) (progn (grdraw pt pt2 3) (setq red T)) ) ) ) (setq s# (1- s#) num (1- num) ) ) (command "ucs" "") (command "color" ccolor) (command "layer" "s" layer "") (setvar "cmdecho" oce) (setq *error* *olderror*) (princ));;;;;; C:PREVIEW - Path script frame preview tool. This command searches an;;; AutoShade script for the requested frame, and uses dview to;;; display the frame.;;;(defun c:preview (/ allframes cam targ lens sfile rangeE rangeS Fpause search ssearch file frame# foundit dviewpt) (setq *olderror* *error* *error* *close* ) (setq ucsicon (getvar "ucsicon")) (setq oce (getvar "cmdecho")) ;; Find directory information (if (not fdir) (getdir)) ;;get the directory info (if (not hfile) (setq hfile (strcat fdir (justname (getvar "dwgname")))) ) (if file (progn (setq file (getstring (strcat "\nName of script to preview <" hfile ">: ") ) ) (if (= file "") (setq file hfile)) ) (setq dwg_name (strcat fdir (justname (getvar "dwgname"))) file (getstring (strcat "\nName of script to preview <" dwg_name ">: " ) ) ) ) (if file (progn (if (= file "") (setq sfile (open (strcat dwg_name ".scr") "r")) (setq sfile (open (strcat file ".scr") "r")) ) (if sfile (progn (setvar "cmdecho" 0) (setvar "ucsicon" 0) (command "point" "0,0,0") (setq dviewpt (entlast)) (initget 6) (setq frame# (getint "\nFrame number (press RETURN to view a range): ") twist "0" search T ) (if (not frame#) (progn (initget 6) (setq rangeS (getint "\nStart preview at frame (press RETURN for all): ") ) (if rangeS (setq rangeE (getint "\nStop preview at frame (press RETURN for end): ") frame# rangeS ) (setq frame# 1) ) (initget "Yes No") (setq fpause (getkword "\nPause between frames? <Y>: ")) (if (= fpause "Yes") (setq fpause nil)) (setq allframes T) ) ) (while (and search (setq line (read-line sfile))) (if (not allframes) (princ "\rSearching script ><")) (if (= (substr line 1 4) "lens" ) ;;in the event the lens is only in the header (setq lens (substr line 6)) ) (if (= (substr line 1 5) "twist") ;;in the event the twist is only in the header (setq twist (substr line 7)) ) ;; frame found, get info (if (= (substr line 1 (+ (strlen (itoa frame#)) 10)) (strcat ". **FRAME " (itoa frame#) ) ) (progn (setq ssearch (read-line sfile)) (while ssearch (if (= (substr line 1 4) "lens") (setq lens (substr line 6)) ) (if (= (substr line 1 5) "twist") (setq twist (substr line 7)) ) (if (= (substr line 1 6) "target") (setq targ (substr line 8)) ) (if (= (substr line 1 6) "camera") (setq cam (substr line 8)) ) (if (= (setq line (read-line sfile)) ". *") (setq ssearch nil) ) ) (if (not allframes) (setq search nil)) ) (if (not allframes) (princ "\rSearching script <>") ) ) (if (= rangeE (1- frame#)) (setq search nil lens nil ) ) (if (and lens cam (/= (substr line 1 11) ". **THE END")) (progn (if allframes (princ (strcat "\r**Frame "(itoa frame#)" ")) (princ (strcat "\rFound frame "(itoa frame#)" ")) ) (command "dview" dviewpt "" "po" targ cam "d" "" "z" lens "tw" twist "" ) (if (and allframes (not fpause)) (progn (princ "\n*press any key to continue*") (grread) ) ) (if allframes (setq frame# (1+ frame#)) (setq foundit T) ) ) ) ; end of if lens cam ) ; end of the while ;; end of file search (close sfile) (if (and (not allframes) (not foundit)) (prompt (strcat "\rFrame " (itoa frame#) " not found ")) ) ) ; end of file found progn (progn (prompt "\nFile not found") (setq hfile nil) ) ) ) ) (if dviewpt (entdel dviewpt)) (setvar "ucsicon" ucsicon) (setvar "cmdecho" oce) (setq *error* *olderror*) (princ));;;;;; SLDview ;;; by Jamie Clay;;; A command to read Path's AutoShade script files, apply the information;;; to DVIEW in AutoCAD and make a slide.;;; Pre-release : CompuServe distribution and support only :;;;(defun c:SLDview (/ lens cam targ file scene hide count twist sshade) (setq *olderror* *error* *error* *close* dwg_name (justname (getvar "dwgname")) count 1 twist "0" osmode (getvar "osmode") ) (setvar "osmode" 0) (if (not fdir) (getdir)) ;;get the directory info (while (not file) (setq file (getname (strcat "\nPATH script to use <" fdir dwg_name ">:" ))) (if (not file) (prompt "\nInvalid file name, please re-enter.")) ) (if (= file "") (setq file (strcat fdir dwg_name)) ) (setq mvi_name file sld_name file file (open (strcat file ".scr") "r") lread 1 ) (princ "\n") (setq oce (getvar "cmdecho")) (setvar "cmdecho" 0) (if file (progn (setq sfile (open (strcat mvi_name ".mvi") "w")) (initget "Yes No") ;; Ask if they want to use hide (setq hide (getkword "\nApply hide? <N>: ")) (if (= hide "No") (setq hide nil) ) ;; If Release 11, ask if they want viewport shadeing (initget "Yes No") (if (and (getvar "PLATFORM") (not hide)) (setq sshade (getkword "\nApply AutoCAD shading? <N> ")) ) (if (= sshade "No") (setq sshade nil) ) (while (and (setq line (read-line file)) (/= lread 0)) ;; in the event the lens is only in the header (if (= (substr line 1 4) "lens" ) (setq lens (substr line 6)) ) ;; in the event the twist is only in the header (if (= (substr line 1 5) "twist") (setq twist (substr line 7)) ) (if (= (substr line 1 9) ". **FRAME") (progn (setq lread 1) (while (or (not cam) (not targ)) (setq line (read-line file)) (cond ((= (substr line 1 4) "lens") (setq lens (substr line 6)) ) ((= (substr line 1 5) "twist") (setq twist (substr line 7)) ) ((= (substr line 1 6) "target") (setq targ (substr line 8)) ) ((= (substr line 1 6) "camera") (setq cam (substr line 8)) ) ) (setq lread (1+ lread)) (if (> lread 100) ; If we went 100 lines and didn't find (setq cam T ; something, shut down the process. targ T lread 0 ) ) ) ; end o the while (if (/= lread 0) (progn (if (not count) (setq line (read-line file) count (read (substr line (- (strlen line) 3))) ) ) (if hide (princ (strcat "\rApplying hide to slide frame # " (itoa count)) ) (princ (strcat "\rCreating slide frame # " (itoa count)) ) ) (command "dview" "" "po" targ cam "d" "" "z" lens "tw" twist "") (if hide (command "hide") (if sshade (command "SHADE") ) ) ;; get the slide name and count (setq slide (cname (substr (justname sld_name) 1 4) count) ) ;; create the slide (command "mslide" (strcat fdir slide)) ;; write the .mvi file (write-line (strcat slide ".sld") sfile) (setq count (1+ count) cam nil targ nil line (read-line file) ) ) ; end of progn (prompt "\nCould not find camera and target data in this file.") ) ; end of if lread ) ; end of if frame progn ) ; end of if frame ) ; end of the while (if (/= lread 0) (prompt (strcat "\nAnimation list " (strcase mvi_name) ".MVI has been created.") ) ) (close sfile) (close file) ) ; end of progn (prompt "\nFile not found") ) (setvar "osmode" osmode) (setvar "cmdecho" oce) (setq *error* *olderror*) (princ));;;;;; PTSout -- a command to write a point list out to a file;;;(defun c:PTSout (/ ptfile ptf txtpt) (setq *olderror* *error* *error* *close* ) (if (not fdir) (getdir)) ; get the directory info (while (not ptfile) (setq ptf (getstring "\nName for point file: ")) (if (/= ptf "") (setq ptfile (open (strcat fdir ptf ".pts") "w")) ) (if (not ptfile) ; in case they enter their own suffix (setq ptfile (open (strcat fdir ptf) "w")) ) ) ;; find the start text point (while (not txtpt) (setq txtpt (entsel "\nSelect the last number: ")) (if txtpt (progn (setq txtpt (car txtpt)) (if (/= (getass 0 txtpt) "TEXT") (setq txtpt nil) ) ) ) ) (setq txtpt# (read (getass 1 txtpt))) (princ "ATK POINT LIST\n**Total points in this file:" ptfile) (print txtpt# ptfile) (repeat txtpt# (setq ppnt (trans (getass 11 txtpt) txtpt 0)) (princ (strcat "\n**Frame " (getass 1 txtpt)) ptfile) (print ppnt ptfile) (setq txtpt (entnext txtpt)) ) (close ptfile) (prompt (strcat "\nATK point list file " fdir ptf ".pts has been created.")) (setq *error* *olderror*) (princ));;;;;; PTSin -- a command that makes a polyline from a .PTS file;;;(defun c:ptsin (/ pfile ptsfile polytype) (setq *olderror* *error* *error* *close* ) (setq oce (getvar "cmdecho")) (setvar "cmdecho" 0) (setq ptsfile (getstring "\n.PTS file to read: ")) (if (/= ptsfile "") (progn (setq pfile (open ptsfile "r")) (if (not pfile) (setq pfile (open (strcat fdir ptsfile ) "r")) ) (if (not pfile) (setq pfile (open (strcat fdir ptsfile ".pts") "r")) ) ) ) (if pfile (progn (initget "2d 3d") (setq polytype (getkword "\nType of polyline to create - 2d/3d <2d>: ") ) (if (= polytype "3d") (setq polytype "3dpoly") (setq polytype "pline") ) (command polytype) (while (setq point (read-line pfile)) (if (= (type (read point)) 'LIST) (command (read point)) ) ) (command) ) (prompt "\nFile not found") ) (setvar "cmdecho" oce) (setq *error* *olderror*) (princ));;;;;; RevPoly -- a quick and dirty command used to reverse a polyline;;; "direction".;;;(defun c:revpoly (/ pline fit spline vlist vertex virtexl index) (setq *olderror* *error* *error* *close* ) (setq oce (getvar "cmdecho")) (setvar "cmdecho" 0) (while (not pline) (setq pline (entsel "\nSelect a polyline to reverse: ")) (setq pline (polytest pline)) ) (setq pline (car pline)) (if (/= (logand (getass 70 pline) 8) 8) (command "ucs" "e" pline) ) ;; If the polyline isn't straight, to make things simple, decurve it. (if (= (logand (getass 70 pline) 4) 4) (progn (command "pedit" pline "d" "") (setq spline T) ) ) (if (= (logand (getass 70 pline) 3) 3) (progn (command "pedit" pline "d" "") (setq fit T) ) ) (setq vertex (entnext pline)) ;; build the vertex list (while (/= (getass 0 vertex) "SEQEND") (setq vpoint (getass 10 vertex)) (if vlist (setq vlist (append vlist (list vpoint))) (setq vlist (list vpoint)) ) (setq vertex (entnext vertex)) ) (setq vertex (entnext pline) vlist (reverse vlist) ) (setq index 0) (while (/= (getass 0 vertex) "SEQEND") (setq vertexl (subst (cons 10 (nth index vlist)) (cons 10 (getass 10 vertex)) (entget vertex) ) ) (entmod vertexl) (setq vertex (entnext vertex)) (setq index (1+ index)) ) (entupd pline) (if spline (command "pedit" pline "s" "") ) (if fit (command "pedit" pline "f" "") ) (if (/= (logand (getass 70 pline) 8) 8) (command "ucs" "p") ) (prompt "\nPolyline reversed.") (setvar "cmdecho" oce) (setq *error* *olderror*) (princ));;;;;; PCIRCLE -- For those times when a circle just won't do. ;;; Primary function used to convert Circles into closed Polylines;;;;;; Command to convert single circles into closed Polylines;;;(defun c:PCIRCLE (/ center radius pt1 cir cirList) (setq *olderror* *error* *error* *close* ) (setq cir (car (entsel "\nSelect Circle to convert: "))) (setq cirList (entget cir)) (if (= (cdr (assoc 0 cirList)) "CIRCLE") (c2p) (prompt "\nEntity selected is not a circle.") ) (setq *error* *olderror*) (princ));;;;;; C2P -- Function to convert circles into closed polylines.;;;(defun c2p () (setq oce (getvar "cmdecho")) (setvar "cmdecho" 0) (command "ucs" "e" cir) (command "divide" (cons cir '((0 0 0))) "4") ;; Points are placed in previous selection set by the divide command. (setq points (ssget "p")) (command "pline" (trans (getass 10 (ssname points 0)) 0 1) (trans (getass 10 (ssname points 1)) 0 1) (trans (getass 10 (ssname points 2)) 0 1) (trans (getass 10 (ssname points 3)) 0 1) "c" ) (command "erase" points cir "") (command "pedit" "l" "f" "x") (redraw) (command "ucs" "p") (setvar "cmdecho" oce));;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Supporting defuns * ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; PTSRead -- function used to read in a point list file;;; (defun ptsread (ptf / revpath txtpt) (setq ptlist nil txtpt# nil ) (initget "Yes No") (setq revpath (getkword "\nReverse path direction? <N>: ")) (if (= revpath "No") (setq revpath nil)) (setq ptfile (open (strcat fdir ptf ".pts") "r")) (if (not ptfile) ; try without extension (setq ptfile (open (strcat fdir ptf) "r")) ) (if (not ptfile) ; try without prefix (setq ptfile (open ptf "r")) ) (if ptfile (progn ;; Find the number of points in this file, ignore comments (while (not txtpt#) (setq txtpt# (read (read-line ptfile))) (if (/= (type txtpt#) 'INT) (setq txtpt# nil) ) ) (if txtpt# (repeat txtpt# (setq txtpt nil) (while (setq txtpt (read-line ptfile)) (setq txtpt (read txtpt)) (if (= (type txtpt) 'LIST) (if ptlist (setq ptlist (append ptlist (list txtpt))) (setq ptlist (list txtpt)) ) ) ) ) ) (close ptfile) (if (= (length ptlist) txtpt#) (if revpath (setq ptlist ptlist) (setq ptlist (reverse ptlist)) ) (setq ptlist nil) ) ) (prompt "\nFile not found ") ));;;;;; (*CLOSE* e) -- The *error* function for all ATK routines;;;(defun *close* (e) (gc) ;; clean house ;; reset the error function (setq m# strt# *error* *olderror* ) ;; close open files (if SCR_file (close SCR_file)) ; close the script (if MVI_file (close MVI_file)) ; close the mvi file (if outfile (close outfile)) ; close the output file (if seefile (close seefile)) ; close a view file (if pfile (close pfile)) ; close a pts file (setq oce (getvar "cmdecho")) (setvar "cmdecho" 0) ;; set the system up the way we found it (command "ucsicon" "all" "on") (if flatland (setvar "flatland" flatland)) (if osmode (setvar "osmode" osmode)) (if clayer (setvar "clayer" clayer)) (if pdmode (setvar "pdmode" pdmode)) (if ucsfollow (setvar "ucsfollow" ucsfollow)) (if attreq (setvar "attreq" attreq)) (setvar "highlight" 1) (command "undo" "end") (setvar "cmdecho" oce) ;; print the error (if (/= e "Function cancelled") (if (= e "quit / exit abort") (princ) (princ (strcat "\nError: " e)) ) ) (princ));;;;;; (GATHER ent div#) -- a general path point gathering routine.;;; ent = any polyline;;; div# = number of points to generate;;;(defun gather (ent div# / v1 v2 v3 closed ptest revpath startpt endpt elist ptlist) (setq sp (last ent) ent (car ent) elist (entget ent) ptest T echo (getvar "cmdecho") pdmode (getvar "pdmode") ) (initget "Yes No") (setq revpath (getkword "\nReverse path direction? <N>: ")) (if (= revpath "No") (setq revpath nil)) (prompt "\nDividing polyline and collecting points...") ;; Check that the entity selected is a polyline. ;; If it's closed, just divide it and collect the points. ;; Otherwise, traverse the polyline, saving the starting and ending ;; vertices. Add these to the point list in their proper places. (while ptest (if (/= (logand (cdr (assoc 70 elist)) 1) 1) ;; An open polyline (progn (setq div# (1- div#) ;set divide one less v1 (entget (entnext ent)) ;get first vertex ;;collect startpoint startpt (trans (cdr (assoc 10 v1)) ent 0) v2 (entget (entnext (cdr (assoc -1 v1)))) ;get next vertex v3 (trans (cdr (assoc 10 v2)) ent 0) ;get next point ) (while v1 ;find the last vertex (if (= (cdr (assoc 0 v2)) "SEQEND") (setq v1 nil ptest nil ) (setq v3 (trans (cdr (assoc 10 v2)) ent 0) v2 (entget (entnext (cdr (assoc -1 v2)))) ) ) ) (setq endpt v3) ; set the end point ) ;; A closed polyline -- nothing much to do. (setq closed T ptest nil ) ) (setq ptest nil) ) ;; Start making the point list (if closed (setq 1spt T) (setq ptlist (list endpt)) ; start the point list ) (setvar "cmdecho" 0) (setvar "pdmode" 0) ;; The great divide (command "divide" sp div#) ; make some points ;; in the event they ^C the divide command, here's a failsafe exit. (if closed (if (/= (sslength (ssget "p")) div#) (exit)) ; if it's a closed pline (if (/= (sslength (ssget "p")) (1- div#)) (exit)) ; if it's open ) (setvar "cmdecho" echo) (setvar "pdmode" pdmode) ;; Collect and remove the divide points (repeat (if closed div# (1- div#)) ;; get the point for the list (setq t1 (cdr (assoc 10 (entget (entlast))))) (if 1stpt (setq ptlist (list t1) 1stpt nil ) (setq ptlist (cons t1 ptlist)) ; add the point to the list ) (entdel (entlast)) ; remove the point entity ) ;; Finish off the point list (if (not closed) (setq ptlist (cons startpt ptlist)) ; add the start point ) ;; Return the contents of the point list (if revpath (setq ptlist (reverse ptlist)) (setq ptlist ptlist) ));;;;;; (cname f n) - a function used to create the correct numbering for files;;; f = filename, n = number to append(defun cname (f n) (cond ((<= n 9) (strcat f "000" (itoa n))) ((<= n 99) (strcat f "00" (itoa n))) ((<= n 999) (strcat f "0" (itoa n))) ((> n 999) (strcat f (itoa n))) ));;;;;; (OUTPUT) -- Command used to set the output format for the kinetic routines.;;;(defun output (/ a) (if oset (princ (strcat "\nCurrent output is to " oset)) (progn (princ "\nCurrent output is to filmroll")
- (setq oset "filmroll" deed "filmroll" sfx ".flm" ) ) ) (initget "DXF Drawing Slide Test Filmroll Exit X")
- (if (= deed "TEST") (setq a (getkword (strcat "\nSet output format to DXF/Drawing/Filmroll/Slide/Exit <"oset">: ")
- ) ) (setq a (getkword (strcat "\nSet output format to DXF/Drawing/Filmroll/Slide/Test <"oset">: ")
- ) ) ) (cond ((= a "DXF") (setq deed "DXFOUT" sfx ".dxf" oset "DXF"))
- ((= a "Drawing") (setq deed "SAVE" sfx ".dwg" oset "Drawing")) ((= a "Slide") (setq deed "MSLIDE" sfx ".sld" oset "Slide")) ((= a "Test") (setq deed "TEST" sfx ".tst" oset "Test")) ((= a "Filmroll") (setq deed "FILMROLL" sfx ".flm" oset "Filmroll")) ((or (= a "X") (= a "Exit")) (setq deed nil sfx nil oset nil)) ) (if deed (princ (strcat "\nOutput format is set to " oset))) (if (= deed "MSLIDE") (progn (initget "Yes No") (setq seepath (getkword "\nWould you like the view to follow a PATH script? <N>: ") ) (if (= seepath "Yes") (while (/= (type seepath) 'FILE) (setq cpath (strcat fdir (justname (getvar "dwgname"))) hdir fdir seepath nil ) (while (not seepath) (setq seepath (getname (strcat "\nPath script file to use <" cpath ">: ") ) fdir hdir ) (if (not seepath) (prompt "\nInvalid file name, please re-enter.") ) ) (if (or (= seepath "") (null seepath)) (setq seepath cpath)) (if (not (setq seepath (open (strcat seepath ".scr") "r"))) (princ "\nFile not found ") ) ) ;; == seepath "No" or null (setq seepath nil) ) (initget "Yes No") (setq hide (getkword "\nApply hide? <N>: ")) (if (/= hide "Yes") (setq hide nil)) ;; If Release 11, ask if they want viewport shadeing (initget "Yes No") (if (and (getvar "PLATFORM") (not hide)) (setq sshade (getkword "\nApply AutoCAD shading? <N> ")) ) (if (= sshade "No") (setq sshade nil) ) ;; Ask if they want to remove select polyline paths (initget "Yes No") (setq rem (getkword "\nRemove paths? <Y>: ")) (if (= rem "No") (setq rem nil) (setq rem T) ) ) ) (princ));;;;;; (POLYTEST) -- Function to check for a polyline;;;(defun polytest (x) ; x = entsel list (if x (if (and (= "POLYLINE" (cdr (assoc 0 (entget (car x))))) ;;see if it's a polyline and not a mesh (/= (logand (cdr (assoc 70 (entget (car x)))) 16) 16)) T (progn (setq x nil) (princ "\nInvalid entity, please try again.") ) ) ) (setq x x));;;;;; (PLEN x d) -- Function used to get two points from a ;;; divide process. Used for finding segment ;;; and overall lengths.;;; x = pline, d = divide number;;;(defun plen (x d) (setq oce (getvar "cmdecho")) (setvar "cmdecho" 0) (command "divide" x d) (setq points (ssget "p")) (setq pt1 (getass 10 (ssname points 0)) pt2 (getass 10 (ssname points 1)) total (* (distance pt1 pt2) d) ) (if points (command "erase" "P" "")) (setvar "cmdecho" oce));;;;;; (SUPFILE a n) -- Support file function used in KINETIC ;;; and BLOCKIT to create and update support text files. ;;; a = current frame identifier n = the output file name.;;;(defun supfile (a n) (if (= deed "SAVE") (setq fname (strcat n ".blt")) (setq fname (strcat n ".mvi") a (strcat a ".sld") ) ) (if (not outfile) (if (and (findfile (strcat fdir fname))(/= strt# 1)) ;;add to the current file if it exists (progn (setq outfile (open (strcat fdir fname)"a") appfile T ) (write-line "* Appended" outfile) ) (progn (setq outfile (open (strcat fdir fname)"w")) (if (= deed "SAVE") (write-line "* ATK Block list" outfile) (write-line "* ATK Slide list" outfile) ) ) ) ) (write-line a outfile));;;;;; (VIEW f) -- Function used to view AutoShade script scenes as they are ;;; found in the open file. f = file to read;;;(defun view (f) (setq search T vtwist "0" ) (while search (setq rline (read-line f)) (if rline (progn (cond ((= (substr rline 1 4) "lens") (setq vlens (substr rline 6))) ((= (substr rline 1 5) "twist") (setq vtwist (substr rline 7))) ) (if (= (substr rline 1 9) ". **FRAME" ) (progn (read-line f) (while (/= (setq rline (read-line f)) ". *") (cond ((= (substr rline 1 4) "lens") (setq vlens (substr rline 6)) ) ((= (substr rline 1 5) "twist") (setq vtwist (substr rline 7)) ) ((= (substr rline 1 6) "target") (setq vtarg (substr rline 8)) ) ((= (substr rline 1 6) "camera") (setq vcam (substr rline 8)) ) ) (setq search nil) ) ) ) ) (setq search nil) ) ) (if (and rline vtarg vcam vlens vtwist) (command "dview" "" "po" vtarg vcam "d" "" "z" vlens "tw" vtwist "") ));;;;;; (MOTION_STEPS) -- A function used to set start and stop points for;;; entity travel.;;;(defun motion_steps () (setq s# nil r# nil) (setq steps T) (while steps (while (not s#) (initget 6) (prompt "\n\n[Motion Range]") (setq s# (getint (strcat "\nStart motion at frame <1>: "))) (if (or (not s#) (= s# 1)) ; set default value if taken (setq s# 1) (setq s# (1- s#)) ) (if (> s# f#) ; make sure it's not too high (progn (prompt "\nExceeds total frames.") (setq s# nil) ) ) ) ; end of while steps (setq c# 0) ; set the count number to 0 (while (not r#) ; do until we get a number (initget 6) (setq r# (getint (strcat "\nStop motion at frame <" (itoa f#) ">: ") ) ) (if (not r#) (setq r# f#)) ; set the default if taken (if (> r# f#) (progn (setq r# nil) (prompt "\nYour motion frames are greater than the") (prompt "\nnumber of remaining frames, please re-enter.") ) ) ) (cond ((and (/= s# 1) (= r# f#)) (setq r# (- f# (1- s#)))) ((and (= s# 1) (/= r# f#)) T) ((and (/= s# 1) (/= r# f#)) (setq r# (- r# (1- s#)))) (T (setq r# nil)) ) (if (= r# f#) (setq r# nil)) (if (and r# (< r# 3)) (progn (princ "\nNot enough motion frames, must be 3 at a minimum.") (setq steps T s# nil c# nil r# nil ) ) (setq steps nil) ) ) ; end of the while steps);;;;;; (JUSTNAME x) -- Function to return just a file name, sans paths.;;; x = name string to sort;;;(defun justname (x) (setq y (strlen x)) (repeat y (setq z (substr x y)) ;;Look for a path slash (or in mac's case a colon) (if (or (= (ascii z) 92) (= (ascii z) 47)(= (ascii z) 58)) (setq x (substr x (1+ y)) slash T ) ; set the string (setq y (1- y)) ) ) x ; echo the change);;;;;; (GETNAME PR) -- function that returns the file name and sets a new fdir ;;; if offered.;;; pr = prompt string to use;;;(defun getname (pr / aname bname slash) (setq aname (getstring pr)) (if (/= aname "") (progn (setq bname (justname aname));;get just the name (if slash ;;set a new fdir value (setq fdir (substr aname 1 (- (strlen aname)(strlen bname)))) ) ;;see if the directory is valid (if (open (strcat fdir "00ATK00") "w") (setq aname bname) (progn (setq aname nil fdir nil ; clear the fdir setting ) ; return nil if it isn't (getdir) ; reset fdir to previous setting ) ) ) ) aname) ;;;;;; (GETDIR) -- a function for setting the current file storage directory;;;(defun getdir () (setq atkblk (ssget "x" '((2 . "ATKSETUP")))) (if atkblk (progn (if (> (sslength atkblk) 1) (progn (setq atkblk nil) (while (not atkblk) (setq atkblk (car (entsel "\nPlease select ATK Setup to edit: ") ) ) (if atkblk (if (/= "ATKSETUP" (cdr (assoc 2 (entget atkblk)))) (setq atkblk nil) ) ) ) ) (setq atkblk (ssname atkblk 0)) ) (atkread atkblk) ) (setq fdir (getvar "dwgprefix")) ) (princ));;;;;; ATKread, where all data come from!;;;(defun ATKREAD (x) ;; Start the ball rolling. (setq att (entnext (entnext x))) ;; File storage (while (= (getass 0 att) "ATTRIB") (setq attrib (getass 2 att)) (cond ((= attrib "FDIR")(doDIR)) ;; Filmroll name - dwg_name ((= attrib "DWG_NAME") (doNM)) ;; AutoShade scene to use ((= attrib "SCENE") (doSC)) ;; Lens / Zoom information. ((= attrib "CLENS") (doLNS)) ;; Twist information ((= attrib "TWIST") (doTW)) ;; Intersection toggle ((= attrib "INTS") (doINT)) ;; Smooth toggle ((= attrib "SMOOTH") (doSM)) ;; Background color ((= attrib "BCOLOR") (doBC)) ;; Shade type settings ((= attrib "SHT") (doSHT)) ;; Hardcopy or Record setting ((= attrib "RECORD") (doREC)) ;; Rib name ((= attrib "RIBNAME") (doRIB)) ;; RenderMan output destination ((= attrib "ROUTPUT") (setq routput (strcase (getass 1 att)1)) ) ;; Image resolution and aspect ratio ((= attrib "IMAGEREZ") (doIM)) ;; Pixel Samples ((= attrib "PIXSAMP") (doPS)) ;; Shadow toggle ((= attrib "SHADOWS") (doSHD)) ) ; end of the cond (setq att (entnext att)) ) ; end of the while ;; end of the line (princ));;;;;; (dodir) - ATKRead function;;;(defun doDIR () (setq fdir (getass 1 att)) (if (and (/= (substr fdir (strlen fdir) 1) "\\") (/= (substr fdir (strlen fdir) 1) "/")) (setq fdir (strcat fdir "/")) ) (if (not (open (strcat fdir "00ATK00") "w")) (atk_reset "File Storage" (getvar "dwgprefix")) ));;;;;; (doname);;;(defun doNM () (setq dwg_name (getass 1 att)) (if (> (strlen dwg_name) 8) (progn (setq entlist (subst (cons 1 (substr dwg_name 1 8)) (assoc 1 entlist) entlist)) (entmod entlist) ) )) ;;;;;; (doSC);;;(defun doSC () (setq scene (getass 1 att)) (if (= (strcase scene) "NONE") (setq scene "None") ));;;;;; (doLNS);;;(defun doLNS () (setq Clens (getass 1 att)) ; get the lens attribute (if (= (type (read Clens)) 'SYM) ; see if it's a zoom process (progn ;;get the first value (setq lens_s (comma Clens) ;;get the second value lens_e (substr clens (+ (strlen lens_s) 2)) ;;convert values from strings to reals or ints lens_s (read lens_s) lens_e (read lens_e) ;; Set clens flag to "Zoom" for other routines. Clens "Zoom" ) ;;check for something wrong (if (or (= lens_s lens_e) (= (type lens_e) 'SYM) (= (type lens_s) 'SYM) (<= lens_e 0) (<= lens_s 0)) (progn (atk_reset "Lens length" "30") (setq Clens nil) ) (setq lens_s (float lens_s) lens_e (float lens_e) ) ) ) (progn (setq Clens (read Clens)) ; convert Clens from a string (if (<= Clens 0) (atk_reset "Lens length" "30") ) ) ));;;;;; (doTW);;;(defun doTW () (setq twist (getass 1 att)) ; get the twist info (if (/= (strcase twist) "NONE") ; see if it's on (if (= (type (read twist)) 'SYM) ; check for the fixed flag (progn (setq twist (read (substr twist 2)) twfx T ) (if (= (type twist) 'SYM) (progn (atk_reset "Camera twist" "None") (setq twist nil) (entmod entlist) ) (setq twist (float twist)) ) ) (setq twist (float (read twist)) twfx nil ) ) (setq twist "None") )) ;;;;;; (doINT);;;(defun doINT () (setq ints (strcase (getass 1 att))) (cond ((= ints "OFF") (setq ints "No")) ((= ints "ON") (setq ints T)) (T (atk_reset "Intersection" "Off")) )) ;;;;;; (doSM);;;(defun doSM () (setq smooth (strcase (getass 1 att))) (cond ((= smooth "OFF") (setq smooth nil)) ((= smooth "ON") (setq smooth T)) (T (atk_reset "Smooth" "Off")) ));;;;;; (doBC);;;(defun doBC () (setq bcolor (getass 1 att)) (if (or (> (read bcolor) 255) (< (read bcolor) 0) (/= (type (read bcolor)) 'INT)) (atk_reset "Background color number" "0") ) (if (= bcolor "0") (setq bcolor nil) ));;;;; ;(doSHT);;;(defun doSHT () (setq sht (strcase (substr (getass 1 att) 1 2))) (cond ((= sht "FU") (setq sht 1)) ; Full Shade ((= sht "FA") (setq sht 2)) ; Fast Shade ((= sht "QU") (setq sht 3)) ; Quick Shade ((= sht "SL") (setq sht 4)) ; Slide (AutoCAD) ((= sht "RE") (setq sht 5)) ; Renderman File (T (atk_reset "Autoshade Output" "Fullshade")) ));;;;;; (doREC);;;(defun doREC () (setq record (strcase (substr (getass 1 att) 1 2))) (if (and (/= record "RE") ; Record (/= record "HA") ; Hardcopy (/= record "SA") ; Save Image (/= record "RI")) ; RIB (Renderman) (progn (atk_reset "Save image with" "Record") (setq record nil) ) )) ;;;;;; (doRIB);;;(defun doRIB () (setq ribname (getass 1 att)) (if (= (strcase ribname 1) "none") (setq ribname nil) ));;;;;; (doIM);;;(defun doIM () (setq imagerez (getass 1 att)) ;; get the X value (setq xrez (comma imagerez) imagerez (substr imagerez (+ (strlen xrez) 2)) ) ;; get the y value (setq yrez (comma imagerez) prate (substr imagerez (+ (strlen yrez) 2)) ) ;; see if prate starts with a decimal point (if (= (substr prate 1 1) ".") (setq prate (strcat "0" prate)) ) ;; final check and reset if invalid values are found. (if (or (and (/= (type (read prate)) 'REAL) (/= (type (read prate)) 'INT)) (/= (type (read xrez)) 'INT) (/= (type (read yrez)) 'INT)) (atk_reset "Image Resolution" "512,400,1") (setq imagerez (strcat xrez "," yrez)) )) ;;;;;; (doPS);;;(defun doPS () (setq pixsamp (getass 1 att) xsamp (comma pixsamp) ysamp (substr pixsamp (+ (strlen xsamp) 2)) ) (if (= (strcase pixsamp) "NONE") (setq pixsamp nil) (if (or (/= (type (read xsamp)) 'INT) (/= (type (read ysamp)) 'INT)) (atk_reset "Pixel samples" "2,2") ) ));;;;;; (doSHD);;;(defun doSHD () (setq shads (strcase (getass 1 att))) (cond ((= shads "OFF") (setq shads nil)) ((= shads "ON") (setq shads T)) (T (atk_reset "Shadows" "Off")) ));;;;;; comma - function to find the first comma in a string, ;;; this returns the string preceeding the first comma.;;;(defun comma (x / index ca) (setq index 1 ca nil) (while (/= "," ca) (setq ca (substr x index 1) ; find the comma index (1+ index) ) (if (> index 20) (setq ca ",")) ) (substr x 1 (- index 2)));;;;;; Getass - Function that returns an association, plus sets the ;;; entlist value used in ATKREAD;;; x = associated number, y = entity name;;;(defun getass (x y) (if (and x y) (progn (setq entlist (entget y)) (cdr (assoc x entlist)) ) ));;;;;; ATK_reset - Function used to reset the attribute value if invalid;;;(defun atk_reset (a b) (prompt (strcat "\n" a ": Invalid entry - Reset to defaut value.")) (setq entlist (subst (cons 1 b) (assoc 1 entlist) entlist)) (entmod entlist)) ;;; end of the load(princ)
-
