home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p086 / 3.img / ACADSUP.LIF / PTOOLS.LSP < prev    next >
Encoding:
Lisp/Scheme  |  1991-06-03  |  50.2 KB  |  7 lines
  1. ;;;*********************************************************************
  2. ;;;   PTOOLS.lsp 1.01
  3. ;;;   Copyright (C) 1990 by Autodesk, Inc.
  4. ;;;  
  5. ;;;   Permission to use, copy, modify, and distribute this software and its
  6. ;;;   documentation for any purpose and without fee is hereby granted.  
  7. ;;;
  8. ;;;   THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED WARRANTY. 
  9. ;;;   ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR PURPOSE AND OF 
  10. ;;;   MERCHANTABILITY ARE HEREBY DISCLAIMED.
  11. ;;; 
  12. ;;;   ATK support functions and commands for use with 
  13. ;;;   PATH.lsp, KINETIC.lsp, BLOCKIT.lsp
  14. ;;;    
  15. ;;;   Designed and implemented by Jamie Clay in June of 1990
  16. ;;;   Reformatted file for compliance with coding standards.  
  17. ;;;     JSY -- Sept. 1990
  18. ;;;    
  19. ;;;*********************************************************************
  20. ;;;
  21. ;;; Commands: ATKEdit  - edit the ATKSetup block
  22. ;;;           ATKSetup - Insert the ATKSetup block
  23. ;;;           Preview  - Preview an AutoShade Script
  24. ;;;           PTSmark  - Tool for displaying frame numbers/postion 
  25. ;;;           PTSout   - Creates a ATK point list from PTSmark numbers
  26. ;;;           RevPoly  - Reverses the direction of a polyline
  27. ;;;           SLDview  - Makes slide files from AutoShade scripts
  28. ;;;
  29. ;;;
  30. ;;;*********************************************************************
  31. ;;;
  32. ;;; Support                               
  33. ;;; Functions: Read the ATKSetup block
  34. ;;;            (atkread x)              x = entity name
  35. ;;;
  36. ;;;            Reset invalid ATKSetup values
  37. ;;;            (atkreset x y)           x = string,  y = new setting
  38. ;;;
  39. ;;;            ATK *error* function
  40. ;;;            (*close* x)              x = error message
  41. ;;;
  42. ;;;            File name/numbering function
  43. ;;;            (cname x y)              x = string,  y = integer
  44. ;;;
  45. ;;;            Search a string for a comma
  46. ;;;            (comma x)                x = string
  47. ;;;
  48. ;;;            Divide a polyline and create a point list
  49. ;;;            (gather x y)             x = polyline,  y = integer
  50. ;;;
  51. ;;;            Return an association within an entity list
  52. ;;;            (getass x y)             x = integer,  y = entity name
  53. ;;;
  54. ;;;            Check for valid file name
  55. ;;;            (getname x)              x = prompt string  
  56. ;;;    
  57. ;;;            Find current storage directory  
  58. ;;;            (getdir) 
  59. ;;;
  60. ;;;            Return a string without the directory prefix
  61. ;;;            (justname x)             x = file name string
  62. ;;;
  63. ;;;            Collet motion step information
  64. ;;;            (motion_steps)
  65. ;;;
  66. ;;;            Set type of output for kinetic processes
  67. ;;;            (output)
  68. ;;;
  69. ;;;            Calculate point distances along a polyline
  70. ;;;            (plen x y)               x = polyline,  y = integer
  71. ;;;
  72. ;;;            Check entity to see if it's a valid polyline
  73. ;;;            (polytest x)             x = entity to check
  74. ;;;
  75. ;;;            Read points in from a specified file
  76. ;;;            (ptsread x)              x = file to read
  77. ;;;
  78. ;;;            Create and update .MVI and .BLT support files
  79. ;;;            (supfile x y)            x = integer,  y = file name
  80. ;;;
  81. ;;;            View a sequence of scenes from an open file
  82. ;;;            (view file)              x = file pointer
  83. ;;;
  84. ;;;*********************************************************************
  85.  
  86. (if (not loaded) (princ "\nLoading ..."))
  87. (vmon)
  88.  
  89. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  90. ;;;       COMMANDS         * 
  91. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  92.  
  93. ;;;
  94. ;;; ATKUpdate -- simple little command for updating the ATKSetup block
  95. ;;;
  96. (defun c:atkupdate (/ oce)
  97.   (setq  *olderror* *error*
  98.          *error* *close*
  99.   )
  100.   (setq oce (getvar "cmdecho"))
  101.   (setvar "cmdecho" 0)
  102.   (setq atkblk (ssget "x" '((2 . "ATKSETUP"))))
  103.   (command "erase" atkblk "" 
  104.            "insert" "atksetup=atksetup" "\03"
  105.   )
  106.   ;; (command) ; This stops scripts!!
  107.   (c:atksetup)
  108.   (setvar "cmdecho" oce)
  109.   (setq *error* *olderror*)
  110.   (princ)
  111. )
  112.   
  113. ;;;
  114. ;;; ATKEdit -- command to allow editing of ATK block
  115. ;;;
  116. (defun c:ATKEDIT (/ oce)
  117.   (setq  *olderror* *error*
  118.          *error* *close*
  119.   )
  120.   (setq oce (getvar "cmdecho"))
  121.   (setvar "cmdecho" 0)
  122.   (setq atkblk (ssget "x" '((2 . "ATKSETUP"))))
  123.   (if atkblk
  124.     (progn
  125.       (if (> (sslength atkblk) 1)
  126.        (progn
  127.          (setq atkblk nil)
  128.          (while (not atkblk)
  129.            (setq atkblk (car 
  130.                           (entsel "\nPlease select ATK Setup to edit: ")
  131.                         )
  132.            )
  133.            (if atkblk 
  134.              (if (/= "ATKSETUP" (cdr (assoc 2 (entget atkblk))))
  135.                 (setq atkblk nil)
  136.              )
  137.            )
  138.          )
  139.        )
  140.        (setq atkblk (ssname atkblk 0))
  141.       )     
  142.       (command "ddatte" atkblk)
  143.       (atkread atkblk)
  144.     )
  145.   )
  146.   (setvar "cmdecho" oce)
  147.   (setq *error* *olderror*)
  148.   (princ)
  149. )
  150.  
  151. ;;;
  152. ;;; ATKSetup -- command for the insertion of the ATKSETUP.dwg block.
  153. ;;;
  154. (defun c:ATKSETUP (/ oce texteval)
  155.   (setq  *olderror* *error*
  156.          *error*    *close*
  157.          texteval   (getvar "texteval")
  158.   )
  159.   (setq oce (getvar "cmdecho"))
  160.   (setq attreq (getvar "attreq"))
  161.   (setvar "attreq" 1)
  162.   (setvar "cmdecho" 0)
  163.   (setvar "texteval" 1)
  164.   (setq ribname (ssget "x" '((2 . "RM_RCB"))))
  165.   (if ribname
  166.     (setq ribname (cdr (assoc 1 (entget (entnext (ssname ribname 0)))))
  167.           sht "RenderMan"
  168.     )
  169.     (setq ribname "None"
  170.           sht ""
  171.     )
  172.   )
  173.   (setq scene (ssget "x" '((2 . "CLAPPER"))))
  174.   (if scene
  175.     (setq scene (cdr (assoc 1 (entget (entnext (ssname scene 0))))))
  176.     (setq scene "")
  177.   )
  178.   (if (not fdir)
  179.     (setq fdir (getvar "dwgprefix"))
  180.   )
  181.   (initget 1)
  182.   (setq atkname (getstring "\nATK Setup name: "))
  183.   (initget 1)
  184.   (setq inspt (getpoint "\nATK Setup location: "))
  185.   (command "insert"
  186.            "atksetup"                 ; block name
  187.            inspt                      ; insertion point
  188.            (/ (getvar "viewsize") 10.0)  ;block scale
  189.            "" ""                      ; Y=X, No rotation
  190.            atkname                      ; user supplied name
  191.            fdir                       ; Fdir value
  192.            (getvar "dwgname")         ; Filmroll title
  193.            scene                      ; Scene to use
  194.            ""                         ; lens
  195.            ""                         ; twist
  196.            ""                         ; intersection
  197.            ""                         ; Smooth shade
  198.            ""                         ; background color number
  199.            sht                        ; Shade type
  200.            ""                         ; Record toggle
  201.            ribname                    ; RSB block name
  202.            ""                         ; Destination
  203.            ""                         ; Render res and aspect ratio
  204.            ""                         ; pixel samples 
  205.            ""                         ; Shadow switches
  206.   )
  207.   (command "ddatte" (entlast))
  208.   (atkread (entlast))
  209.   (setvar "cmdecho" oce)
  210.   (setvar "texteval" texteval)        
  211.   (setvar "attreq" attreq)
  212.   (setq *error* *olderror*)
  213.   (princ)
  214. )
  215.  
  216.  
  217. ;;;
  218. ;;; C:PLENGTH -- Measures both total and segment lengths of a polyline.
  219. ;;;
  220. (defun c:plength (/ pline div)
  221.   (setq *olderror* *error*
  222.         *error* *close*
  223.   )
  224.  
  225.   (while (not pline)
  226.     ;;get a polyline to process
  227.     (setq pline (entsel "\nSelect a polyline: " ))  
  228.     (setq pline (polytest pline))
  229.   )
  230.   (while (not div)
  231.     (initget 7)
  232.     (setq div (getint "\nNumber of frames: "))
  233.     (if (< div 3)
  234.       (setq div nil)
  235.     )
  236.   )
  237.  
  238.   (plen pline div);;process the pline
  239.  
  240.   (princ (strcat "\nSingle segment length for "(itoa div)" frames = "))
  241.   (princ (distance pt1 pt2))
  242.   (princ "\nTotal length = ")
  243.   (princ  total)
  244.   (redraw)
  245.   (setq *error* *olderror*)
  246.   (princ)
  247. )
  248.  
  249. ;;;
  250. ;;; C:PTSmark -- A command used to display animation path information.
  251. ;;;              PTSmark will create layer PATH_NUMBERS and place generated
  252. ;;;              numbers on this layer in the color of the selected polyline.
  253. ;;;              PTSMark will also (grdraw) a line between coincidal points 
  254. ;;;              along the first selected polyline and a second polyline or 
  255. ;;;              fixed point.
  256. ;;;
  257. (defun c:ptsmark (/ 1st 2nd numbers pt2 points points2 pline pline2 s#)
  258.   (setq  *olderror* *error*
  259.          *error* *close*
  260.          index 1
  261.   )
  262.   (if (not fdir) (getdir))            ; get the directory info
  263.  
  264.   (while (not s#)
  265.     (initget 7)    
  266.     (setq s# (getint "\nNumber of frames: "))    
  267.     (if (< s# 3) 
  268.       (progn
  269.         (setq s# nil)
  270.         (prompt "\nPlease enter a larger number.")
  271.       )
  272.     )
  273.   )
  274.  
  275.   (while (not 1st)
  276.     (initget "Pline List")
  277.     (setq 1st (getkword "\nFirst path>> Pline/List <Pline>: "))
  278.     (cond 
  279.       ((or (not 1st) (= 1st "Pline"))
  280.          (setq pline (entsel "\nSelect a polyline: ")
  281.                pline (polytest pline)
  282.                1st "Pline"
  283.          )
  284.          (redraw (car pline) 3);;highlight the most selected ployline
  285.       )
  286.       (T 
  287.         (while (not points)
  288.           (setq points (getstring "\nFile name: ")       
  289.                 points (ptsread points)
  290.                 s# txtpt#             
  291.           )
  292.         )
  293.       ) 
  294.     )
  295.   ) 
  296.   (if (not points)
  297.     (setq points (gather pline s#))
  298.   )
  299.  
  300.   (initget "Pline Fixed List None")
  301.   (setq 2nd (getkword "\nSecond path>> Pline/Fixed/List <none>: "))
  302.   (if (= 2nd "None") (setq 2nd nil))
  303.   (if 2nd
  304.     (cond 
  305.       ((= 2nd "Pline")
  306.         (while (not pline2)
  307.           (setq pline2 (entsel "\nSelect a polyline: "))
  308.           (setq pline2 (polytest pline2))
  309.           (if pline2 (redraw (car pline2) 3))
  310.         )
  311.       )
  312.       ((= 2nd "Fixed")
  313.          (initget 1)
  314.          (setq pt2 (getpoint "\nPick a point: "))      
  315.       )
  316.       (T 
  317.         (while (not points2)
  318.          (setq points2 (getstring "\nFile name: "))       
  319.          (setq points2 (ptsread points2))
  320.         )
  321.       )
  322.     )
  323.   )
  324.   
  325.   (initget "Yes No")
  326.   (if (/= 1st "List")
  327.     (if (or pline2 pt2 points2)
  328.       (setq numbers (getkword "\nShow numbers? <N>: "))
  329.       (setq numbers T)
  330.     )
  331.     (setq numbers nil)
  332.   )
  333.   (if (= numbers "No") (setq numbers nil))
  334.   (setq oce (getvar "cmdecho"))
  335.   (setvar "cmdecho" 0)
  336.   (if pline2
  337.     (setq points2 (gather pline2 s#))
  338.   )
  339.   (if numbers                         ; set up for numbers if requested
  340.     (progn
  341.       (setq tsize (/ (getvar "viewsize") 30))  ; get a basic text size
  342.       ;;See if they want a different size
  343.       (setq ts (getdist (strcat "\nText size <" (rtos tsize) ">:"))) 
  344.       (if ts (setq tsize ts))
  345.       (setq ccolor (getvar "ccolor")) ;save current color
  346.       (setq layer (getvar "clayer"))  ;save current layer
  347.       ;;set current color to entity color
  348.       (command "color" (cdr (assoc 62 (entget (car pline))))) 
  349.       ;;check to see if layer is there already
  350.       (if (tblsearch "layer" "path_numbers")  
  351.         (command "layer" "t" "path_numbers" "s" "path_numbers" "")
  352.         (command "layer" "m" "path_numbers" "")
  353.       )
  354.       ;;set text size to 0 so new size can be applied
  355.       (command "style" "" "" "0" "" "" "" "" "") 
  356.       (command "ucs" "V")             ; switch ucs to curent view
  357.     )
  358.   )
  359.   (setq num s#)
  360.   (redraw)                            ; clean the screen of any previous stuff
  361.   (repeat (length points)             ;start the process
  362.     (setq pt (trans (nth (1- s#) points) 0 1))  ;convert the points
  363.     (if numbers
  364.       ;;create numbers if asked for
  365.       (command "text" "C" pt tsize "" (itoa num)) 
  366.     )
  367.     (if (or points2 pt2)
  368.       (progn
  369.         (if points2
  370.           (setq pt2 (trans (nth (1- s#) points2) 0 1))
  371.         )
  372.         (if red
  373.           (progn (grdraw pt pt2 1) (setq red nil))
  374.           (progn (grdraw pt pt2 3) (setq red T))
  375.         )
  376.       )
  377.     )
  378.     (setq s# (1- s#)
  379.           num (1- num)
  380.     )
  381.   )
  382.   (command "ucs" "")
  383.   (command "color" ccolor)
  384.   (command "layer" "s" layer "")
  385.   (setvar "cmdecho" oce)
  386.   (setq *error* *olderror*)
  387.   (princ)
  388. )
  389.  
  390. ;;;
  391. ;;; C:PREVIEW - Path script frame preview tool.  This command searches an
  392. ;;;             AutoShade script for the requested frame, and uses dview to
  393. ;;;             display the frame.
  394. ;;;
  395. (defun c:preview (/ allframes cam targ lens sfile rangeE rangeS Fpause
  396.                     search ssearch file frame# foundit dviewpt)
  397.   (setq *olderror* *error*
  398.        *error* *close*
  399.   )
  400.   (setq ucsicon (getvar "ucsicon"))
  401.   (setq oce (getvar "cmdecho"))
  402.  
  403.   ;; Find directory information
  404.  
  405.   (if (not fdir) (getdir)) ;;get the directory info
  406.  
  407.   (if (not hfile)
  408.     (setq hfile (strcat fdir (justname (getvar "dwgname"))))
  409.   )
  410.  
  411.   (if file
  412.     (progn
  413.       (setq file (getstring 
  414.                    (strcat "\nName of script to preview <" hfile ">: ")
  415.                   )
  416.       )
  417.       (if (= file "") (setq file hfile))
  418.     )
  419.     (setq dwg_name (strcat fdir (justname (getvar "dwgname")))
  420.           file (getstring (strcat 
  421.                             "\nName of script to preview <" dwg_name ">: "
  422.                            )
  423.                )
  424.     )
  425.   )
  426.  
  427.   (if file
  428.     (progn
  429.       (if (= file "")
  430.        (setq sfile (open (strcat dwg_name ".scr") "r"))
  431.        (setq sfile (open (strcat file ".scr") "r"))
  432.       )
  433.       (if sfile
  434.         (progn
  435.           (setvar "cmdecho" 0)
  436.           (setvar "ucsicon" 0)
  437.           (command "point" "0,0,0")
  438.           (setq dviewpt (entlast))
  439.           (initget 6)
  440.           (setq frame# (getint 
  441.                        "\nFrame number (press RETURN to view a range): ")
  442.                 twist "0"
  443.                 search T
  444.           )
  445.           (if (not frame#)
  446.             (progn
  447.               (initget 6)
  448.               (setq rangeS (getint
  449.                      "\nStart preview at frame (press RETURN for all): ")
  450.               )
  451.               (if rangeS
  452.                 (setq rangeE (getint
  453.                       "\nStop preview at frame (press RETURN for end): ")
  454.                       frame# rangeS
  455.                 )
  456.                 (setq frame# 1)
  457.               )             
  458.               (initget "Yes No")
  459.               (setq fpause (getkword "\nPause between frames? <Y>: "))
  460.               (if (= fpause "Yes") (setq fpause nil))
  461.               (setq allframes T) 
  462.             )                
  463.           )       
  464.           (while (and search (setq line (read-line sfile)))
  465.             (if (not allframes) (princ "\rSearching script ><"))
  466.             
  467.             (if (= (substr line 1 4) "lens" )  
  468.               ;;in the event the lens is only in the header
  469.                 (setq lens (substr line 6))
  470.             )
  471.             (if (= (substr line 1 5) "twist")  
  472.               ;;in the event the twist is only in the header
  473.               (setq twist (substr line 7))
  474.             )
  475.             
  476.             ;; frame found, get info
  477.             (if (= (substr line 1 (+ (strlen (itoa frame#)) 10))
  478.                    (strcat ". **FRAME " (itoa frame#) ) )
  479.               (progn
  480.                 (setq ssearch (read-line sfile))
  481.                 (while ssearch
  482.                   (if (= (substr line 1 4) "lens") 
  483.                     (setq lens (substr line 6))
  484.                   )
  485.                   (if (= (substr line 1 5) "twist") 
  486.                     (setq twist (substr line 7))
  487.                   )
  488.                   (if (= (substr line 1 6) "target")
  489.                     (setq targ (substr line 8))
  490.                   )
  491.                   (if (= (substr line 1 6) "camera") 
  492.                     (setq cam (substr line 8))
  493.                   )
  494.                   (if (= (setq line (read-line sfile)) ". *") 
  495.                     (setq ssearch nil)
  496.                   )
  497.                 )
  498.                 (if (not allframes) (setq search nil))
  499.               )
  500.               (if (not allframes)
  501.                 (princ "\rSearching script <>")
  502.               )
  503.             )
  504.            
  505.             (if (= rangeE (1- frame#))
  506.               (setq search nil
  507.                      lens  nil
  508.               )
  509.             )
  510.             
  511.             (if (and lens cam (/= (substr line 1 11) ". **THE END"))
  512.               (progn                
  513.                 (if allframes
  514.                   (princ (strcat 
  515.                     "\r**Frame "(itoa frame#)"                     "))
  516.                   (princ (strcat 
  517.                     "\rFound frame "(itoa frame#)"                 "))
  518.                 )
  519.                 (command "dview" dviewpt "" "po" targ cam 
  520.                          "d" "" "z" lens "tw" twist ""
  521.                 )
  522.                 (if (and allframes (not fpause))
  523.                   (progn
  524.                     (princ "\n*press any key to continue*")
  525.                     (grread)
  526.                   )
  527.                 )
  528.                 (if allframes 
  529.                    (setq frame# (1+ frame#))
  530.                    (setq foundit T)
  531.                 )
  532.               )              
  533.             )                         ; end of if lens cam
  534.           )                           ; end of the while
  535.  
  536.           ;; end of file search
  537.           (close sfile)  
  538.           (if (and (not allframes) (not foundit))
  539.             (prompt (strcat "\rFrame " (itoa frame#) " not found   "))
  540.           )
  541.         )                             ; end of file found progn
  542.         (progn
  543.           (prompt "\nFile not found")
  544.           (setq hfile nil)
  545.         )
  546.       )
  547.     )
  548.   )
  549.   (if dviewpt (entdel dviewpt))
  550.   (setvar "ucsicon" ucsicon)
  551.   (setvar "cmdecho" oce)
  552.   (setq *error* *olderror*)
  553.   (princ)
  554. )
  555.  
  556. ;;;
  557. ;;; SLDview 
  558. ;;; by Jamie Clay
  559. ;;; A command to read Path's AutoShade script files, apply the information
  560. ;;; to DVIEW in AutoCAD and make a slide.
  561. ;;; Pre-release : CompuServe distribution and support only :
  562. ;;;
  563. (defun c:SLDview (/ lens cam targ file scene hide count twist sshade)
  564.  
  565.   (setq *olderror* *error*
  566.         *error*    *close*
  567.         dwg_name   (justname (getvar "dwgname"))
  568.         count      1
  569.         twist     "0"
  570.         osmode (getvar "osmode")
  571.   )
  572.   (setvar "osmode" 0)
  573.  
  574.   (if (not fdir) (getdir)) ;;get the directory info
  575.   
  576.   (while (not file)
  577.     (setq file (getname (strcat "\nPATH script to use <" fdir dwg_name ">:" )))
  578.     (if (not file) (prompt "\nInvalid file name, please re-enter."))
  579.   )
  580.  
  581.   (if (= file "")
  582.     (setq file (strcat fdir dwg_name))
  583.   )
  584.  
  585.   (setq mvi_name file
  586.     sld_name file 
  587.     file (open (strcat file ".scr") "r")
  588.     lread 1
  589.   )
  590.  
  591.   (princ "\n")
  592.   (setq oce (getvar "cmdecho"))
  593.   (setvar "cmdecho" 0)
  594.   (if file
  595.     (progn
  596.       (setq sfile (open (strcat mvi_name ".mvi") "w"))
  597.       (initget "Yes No")
  598.       ;; Ask if they want to use hide
  599.       (setq hide (getkword "\nApply hide? <N>: ")) 
  600.       (if (= hide "No")
  601.         (setq hide nil)
  602.       )
  603.       ;; If Release 11, ask if they want viewport shadeing
  604.       (initget "Yes No")
  605.       (if (and (getvar "PLATFORM") (not hide))
  606.         (setq sshade (getkword "\nApply AutoCAD shading? <N> "))
  607.       )
  608.       (if (= sshade "No")
  609.         (setq sshade nil)
  610.       )
  611.       (while (and (setq line (read-line file)) (/= lread 0))
  612.         ;; in the event the lens is only in the header
  613.         (if (= (substr line 1 4) "lens" )  
  614.           (setq lens (substr line 6))
  615.         )
  616.         ;; in the event the twist is only in the header
  617.         (if (= (substr line 1 5) "twist")  
  618.           (setq twist (substr line 7))
  619.         )
  620.         (if (= (substr line 1 9) ". **FRAME")
  621.           (progn
  622.             (setq lread 1)
  623.             (while (or (not cam) (not targ))
  624.               (setq line (read-line file))
  625.               (cond
  626.                 ((= (substr line 1 4) "lens") 
  627.                   (setq lens (substr line 6))
  628.                 )
  629.                 ((= (substr line 1 5) "twist") 
  630.                   (setq twist (substr line 7))
  631.                 )
  632.                 ((= (substr line 1 6) "target") 
  633.                   (setq targ (substr line 8))
  634.                 )
  635.                 ((= (substr line 1 6) "camera") 
  636.                   (setq cam (substr line 8))
  637.                 )
  638.               )
  639.               (setq lread (1+ lread))
  640.               (if (> lread 100)       ; If we went 100 lines and didn't find
  641.                 (setq cam T           ; something, shut down the process.
  642.                       targ T
  643.                       lread 0
  644.                 )
  645.               )
  646.             )                         ; end o the while
  647.             (if (/= lread 0)
  648.               (progn
  649.                 (if (not count)
  650.                   (setq line  (read-line file)
  651.                         count (read (substr line (- (strlen line) 3)))
  652.                   )
  653.                 )
  654.                 (if hide
  655.                   (princ (strcat "\rApplying hide to slide frame # " 
  656.                                   (itoa count))
  657.                   )
  658.                   (princ (strcat "\rCreating slide frame # " 
  659.                                     (itoa count))
  660.                   )
  661.                 )
  662.  
  663.                 (command "dview" "" "po" targ 
  664.                           cam "d" "" "z" lens "tw" twist "")
  665.  
  666.                 (if hide 
  667.                   (command "hide")
  668.                   (if sshade
  669.                     (command "SHADE")
  670.                   )
  671.                 )
  672.  
  673.                 ;; get the slide name and count
  674.                 (setq slide (cname (substr (justname sld_name) 1 4)  
  675.                             count)
  676.                 ) 
  677.                 ;; create the slide
  678.                 (command "mslide" (strcat fdir slide))   
  679.                 ;; write the .mvi file                                   
  680.                 (write-line (strcat slide ".sld") sfile) 
  681.                 (setq count (1+ count)
  682.                       cam nil
  683.                       targ nil
  684.                       line (read-line file)
  685.                 )
  686.  
  687.               )                       ; end of progn
  688.               (prompt "\nCould not find camera and target data in this file.")
  689.             )                         ; end of if lread
  690.           )                           ; end of if frame progn
  691.         )                             ; end of if frame
  692.       )                               ; end of the while
  693.       (if (/= lread 0)
  694.         (prompt (strcat "\nAnimation list "
  695.                          (strcase mvi_name) 
  696.                         ".MVI has been created.")
  697.         )
  698.       )
  699.       (close sfile)
  700.       (close file)
  701.     )                                 ; end of progn
  702.     (prompt "\nFile not found")
  703.   )
  704.   (setvar "osmode" osmode)
  705.   (setvar "cmdecho" oce)
  706.   (setq *error* *olderror*)
  707.   (princ)
  708. )
  709.  
  710. ;;;
  711. ;;; PTSout -- a command to write a point list out to a file
  712. ;;;
  713. (defun c:PTSout (/ ptfile ptf txtpt)
  714.  
  715.   (setq  *olderror* *error*
  716.          *error* *close*
  717.   )
  718.   
  719.  (if (not fdir) (getdir))             ; get the directory info
  720.  
  721.   (while (not ptfile)
  722.     (setq ptf (getstring "\nName for point file: "))
  723.     (if (/= ptf "") 
  724.       (setq ptfile (open (strcat fdir ptf ".pts") "w"))
  725.     )
  726.     (if (not ptfile)                  ; in case they enter their own suffix
  727.       (setq ptfile (open (strcat fdir ptf) "w"))
  728.     )
  729.   )
  730.  
  731.   ;; find the start text point
  732.   (while (not txtpt)
  733.     (setq txtpt (entsel "\nSelect the last number: "))
  734.     (if txtpt 
  735.       (progn
  736.         (setq txtpt (car txtpt))
  737.         (if (/= (getass 0 txtpt) "TEXT") 
  738.           (setq txtpt nil)
  739.         ) 
  740.       )
  741.     )
  742.   )
  743.  
  744.   (setq txtpt# (read (getass 1 txtpt)))
  745.   (princ "ATK POINT LIST\n**Total points in this file:" ptfile)
  746.   (print txtpt# ptfile)
  747.  
  748.   (repeat txtpt#
  749.     (setq ppnt (trans (getass 11 txtpt) txtpt 0))
  750.     (princ (strcat "\n**Frame " (getass 1 txtpt)) ptfile)
  751.     (print ppnt ptfile)
  752.     (setq txtpt (entnext txtpt))
  753.   )
  754.  
  755.  (close ptfile)
  756.  (prompt (strcat 
  757.          "\nATK point list file " fdir ptf ".pts has been created."))
  758.  (setq *error* *olderror*)
  759.  (princ)
  760. )
  761.  
  762. ;;;
  763. ;;; PTSin -- a command that makes a polyline from a .PTS file
  764. ;;;
  765. (defun c:ptsin (/ pfile ptsfile polytype)  
  766.   (setq  *olderror* *error*
  767.          *error* *close*
  768.   )
  769.   (setq oce (getvar "cmdecho"))
  770.   (setvar "cmdecho" 0)
  771.   (setq ptsfile (getstring "\n.PTS file to read: "))
  772.   (if (/= ptsfile "") 
  773.     (progn
  774.       (setq pfile (open ptsfile "r"))
  775.       (if (not pfile) 
  776.         (setq pfile (open (strcat fdir ptsfile ) "r"))
  777.       )
  778.       (if (not pfile) 
  779.         (setq pfile (open (strcat fdir ptsfile ".pts") "r"))
  780.       ) 
  781.     )
  782.   )
  783.   (if pfile 
  784.     (progn
  785.       (initget "2d 3d")
  786.       (setq polytype
  787.         (getkword "\nType of polyline to create - 2d/3d <2d>: ")
  788.       )
  789.       (if (= polytype "3d")
  790.         (setq polytype "3dpoly")
  791.         (setq polytype "pline")
  792.       )
  793.       (command polytype)
  794.       (while (setq point (read-line pfile))
  795.         (if (= (type (read point)) 'LIST)
  796.           (command (read point))
  797.         )
  798.       )
  799.       (command)
  800.     )
  801.     (prompt "\nFile not found")
  802.   )
  803.   (setvar "cmdecho" oce)
  804.   (setq *error* *olderror*)
  805.   (princ)
  806. )
  807.  
  808.  
  809. ;;;
  810. ;;; RevPoly -- a quick and dirty command used to reverse a polyline
  811. ;;;            "direction".
  812. ;;;
  813. (defun c:revpoly (/ pline fit spline vlist vertex virtexl index)
  814.  
  815.   (setq  *olderror* *error*
  816.          *error* *close*
  817.   )
  818.   (setq oce (getvar "cmdecho"))
  819.   (setvar "cmdecho" 0)
  820.   (while (not pline)
  821.     (setq pline (entsel "\nSelect a polyline to reverse: "))
  822.     (setq pline (polytest pline))
  823.   )
  824.   (setq pline (car pline))
  825.   (if (/= (logand (getass 70 pline) 8) 8)
  826.     (command "ucs" "e" pline)
  827.   )
  828.  
  829.   ;; If the polyline isn't straight, to make things simple, decurve it.
  830.  
  831.   (if (= (logand (getass 70 pline) 4) 4)
  832.     (progn
  833.       (command "pedit" pline "d" "")
  834.       (setq spline T)
  835.     )
  836.   )
  837.   (if (= (logand (getass 70 pline) 3) 3)
  838.     (progn
  839.       (command "pedit" pline "d" "")
  840.       (setq fit T)
  841.     )
  842.   )
  843.  
  844.   (setq vertex (entnext pline))
  845.   
  846.   ;; build the vertex list
  847.   (while (/= (getass 0 vertex) "SEQEND")
  848.     (setq vpoint (getass 10 vertex))
  849.     (if vlist
  850.       (setq vlist (append vlist (list vpoint)))
  851.       (setq vlist (list vpoint))
  852.     )
  853.     (setq vertex (entnext vertex))
  854.   )
  855.  
  856.   (setq vertex (entnext pline)
  857.         vlist (reverse vlist)
  858.   )
  859.   (setq index 0)
  860.   (while (/= (getass 0 vertex) "SEQEND")
  861.     (setq vertexl (subst (cons 10 (nth index vlist)) 
  862.                          (cons 10 (getass 10 vertex)) 
  863.                          (entget vertex)
  864.                  )
  865.     )
  866.     (entmod vertexl)
  867.     (setq vertex (entnext vertex))
  868.     (setq index (1+ index))
  869.   )
  870.  
  871.   (entupd pline)
  872.   (if spline
  873.     (command "pedit" pline "s" "")
  874.   )
  875.   (if fit
  876.     (command "pedit" pline "f" "")
  877.   )
  878.   (if (/= (logand (getass 70 pline) 8) 8)
  879.     (command "ucs" "p")
  880.   )
  881.   (prompt "\nPolyline reversed.")
  882.   (setvar "cmdecho" oce)
  883.   (setq *error* *olderror*)
  884.   (princ)
  885. )
  886.  
  887. ;;;
  888. ;;; PCIRCLE -- For those times when a circle just won't do. 
  889. ;;;            Primary function used to convert Circles into closed Polylines
  890. ;;;
  891. ;;;            Command to convert single circles into closed Polylines
  892. ;;;
  893. (defun c:PCIRCLE (/ center radius pt1 cir cirList)
  894.   (setq  *olderror* *error*
  895.          *error* *close*
  896.   )
  897.   (setq cir (car (entsel "\nSelect Circle to convert: ")))
  898.   (setq cirList (entget cir))
  899.   (if (= (cdr (assoc 0 cirList)) "CIRCLE")
  900.     (c2p)
  901.     (prompt "\nEntity selected is not a circle.")
  902.   )
  903.   (setq *error* *olderror*)
  904.   (princ)
  905. )
  906.  
  907. ;;;
  908. ;;; C2P -- Function to convert circles into closed polylines.
  909. ;;;
  910. (defun c2p ()
  911.   (setq oce (getvar "cmdecho"))
  912.   (setvar "cmdecho" 0)
  913.   (command "ucs" "e" cir)
  914.   (command "divide" (cons cir '((0 0 0))) "4")
  915.   ;; Points are placed in previous selection set by the divide command.
  916.   (setq points (ssget "p"))
  917.   (command "pline" 
  918.     (trans (getass 10 (ssname points 0)) 0 1)
  919.     (trans (getass 10 (ssname points 1)) 0 1)
  920.     (trans (getass 10 (ssname points 2)) 0 1)
  921.     (trans (getass 10 (ssname points 3)) 0 1)
  922.     "c"
  923.   )
  924.   (command "erase" points cir "")
  925.   (command "pedit" "l" "f" "x")
  926.   (redraw)
  927.   (command "ucs" "p")
  928.   (setvar "cmdecho" oce)
  929. )
  930.  
  931.  
  932.  
  933.  
  934. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  935. ;;;       Supporting defuns         * 
  936. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  937.  
  938. ;;;
  939. ;;; PTSRead -- function used to read in a point list file
  940. ;;; 
  941. (defun ptsread (ptf / revpath txtpt)
  942.   (setq ptlist nil
  943.         txtpt# nil
  944.   )  
  945.  
  946.   (initget "Yes No")
  947.   (setq revpath (getkword "\nReverse path direction? <N>: "))
  948.   (if (= revpath "No") (setq revpath nil))
  949.  
  950.   (setq ptfile (open (strcat fdir ptf ".pts") "r")) 
  951.  
  952.   (if (not ptfile) ; try without extension
  953.     (setq ptfile (open (strcat fdir ptf) "r"))
  954.   )
  955.   
  956.   (if (not ptfile) ; try without prefix
  957.     (setq ptfile (open ptf "r"))
  958.   )
  959.  
  960.   (if ptfile
  961.     (progn
  962.       ;; Find the number of points in this file, ignore comments
  963.       (while (not txtpt#)
  964.         (setq txtpt# (read (read-line ptfile)))
  965.         (if (/= (type txtpt#) 'INT)
  966.           (setq txtpt# nil)
  967.         )
  968.       )
  969.      
  970.       (if txtpt#
  971.         (repeat txtpt#
  972.           (setq txtpt nil)
  973.           (while (setq txtpt (read-line ptfile)) 
  974.             (setq txtpt (read txtpt))           
  975.             (if (= (type txtpt) 'LIST)
  976.               (if ptlist
  977.                 (setq ptlist (append ptlist (list txtpt))) 
  978.                 (setq ptlist (list txtpt))
  979.               )
  980.             )
  981.           )
  982.         )
  983.       )
  984.       (close ptfile)
  985.       (if (= (length ptlist) txtpt#)
  986.         (if revpath
  987.           (setq ptlist ptlist)
  988.           (setq ptlist (reverse ptlist))
  989.         )
  990.         (setq ptlist nil)
  991.       )
  992.     )
  993.     (prompt "\nFile not found ")
  994.   )
  995. )
  996.  
  997. ;;;
  998. ;;; (*CLOSE* e) -- The *error* function for all ATK routines
  999. ;;;
  1000. (defun *close* (e)
  1001.   (gc) ;; clean house
  1002.  
  1003.   ;; reset the error function
  1004.   (setq m# strt#
  1005.         *error* *olderror*
  1006.   )
  1007.  
  1008.   ;; close open files
  1009.   (if SCR_file (close SCR_file))      ; close the script
  1010.   (if MVI_file (close MVI_file))      ; close the mvi file
  1011.   (if outfile  (close outfile))       ; close the output file
  1012.   (if seefile  (close seefile))       ; close a view file
  1013.   (if pfile    (close pfile))         ; close a pts file
  1014.  
  1015.   (setq oce (getvar "cmdecho"))
  1016.   (setvar "cmdecho" 0)
  1017.   ;; set the system up the way we found it
  1018.   (command "ucsicon" "all" "on")
  1019.   (if flatland (setvar "flatland" flatland))
  1020.   (if osmode (setvar "osmode" osmode))
  1021.   (if clayer (setvar "clayer" clayer))
  1022.   (if pdmode (setvar "pdmode" pdmode))
  1023.   (if ucsfollow (setvar "ucsfollow" ucsfollow))
  1024.   (if attreq (setvar "attreq" attreq))
  1025.   (setvar "highlight" 1)
  1026.   (command "undo" "end")
  1027.   (setvar "cmdecho" oce)
  1028.  
  1029.   ;; print the error
  1030.   (if (/= e "Function cancelled")
  1031.     (if (= e "quit / exit abort")
  1032.       (princ)
  1033.       (princ (strcat "\nError: " e))
  1034.     )
  1035.   )
  1036.   (princ)
  1037. )
  1038.  
  1039. ;;;
  1040. ;;;  (GATHER ent div#) -- a general path point gathering routine.
  1041. ;;;                       ent = any polyline
  1042. ;;;                       div# = number of points to generate
  1043. ;;;
  1044. (defun gather (ent div# / v1 v2 v3 closed ptest revpath
  1045.                           startpt endpt elist ptlist)
  1046.   (setq sp (last ent)
  1047.         ent (car ent)
  1048.         elist (entget ent)
  1049.         ptest T
  1050.         echo (getvar "cmdecho")
  1051.         pdmode (getvar "pdmode")
  1052.   )
  1053.  
  1054.   (initget "Yes No")
  1055.   (setq revpath (getkword "\nReverse path direction? <N>: "))
  1056.   (if (= revpath "No") (setq revpath nil))
  1057.   
  1058.   (prompt "\nDividing polyline and collecting points...")
  1059.  
  1060.   ;; Check that the entity selected is a polyline.
  1061.   ;; If it's closed, just divide it and collect the points.
  1062.   ;; Otherwise, traverse the polyline, saving the starting and ending
  1063.   ;; vertices.  Add these to the point list in their proper places.
  1064.   (while ptest
  1065.     (if (/= (logand (cdr (assoc 70 elist)) 1) 1)
  1066.       ;; An open polyline
  1067.       (progn
  1068.         (setq div# (1- div#)          ;set divide one less
  1069.               v1 (entget (entnext ent))  ;get first vertex
  1070.               ;;collect startpoint
  1071.               startpt (trans (cdr (assoc 10 v1)) ent 0)             
  1072.               v2 (entget (entnext (cdr (assoc -1 v1))))  ;get next vertex
  1073.               v3 (trans (cdr (assoc 10 v2)) ent 0)  ;get next point
  1074.         )
  1075.         (while v1                     ;find the last vertex
  1076.           (if (= (cdr (assoc 0 v2)) "SEQEND")
  1077.             (setq v1 nil
  1078.                   ptest nil
  1079.             )
  1080.             (setq v3 (trans (cdr (assoc 10 v2)) ent 0)
  1081.                   v2 (entget (entnext (cdr (assoc -1 v2))))
  1082.             )
  1083.           )
  1084.         )
  1085.         (setq endpt v3)               ; set the end point
  1086.       )
  1087.       ;; A closed polyline -- nothing much to do.
  1088.       (setq closed T
  1089.             ptest nil
  1090.       )
  1091.     )
  1092.     (setq ptest nil)
  1093.   )
  1094.  
  1095.   ;; Start making the point list
  1096.   (if closed
  1097.     (setq 1spt T)
  1098.     (setq ptlist (list endpt))        ; start the point list
  1099.   )
  1100.   (setvar "cmdecho" 0)
  1101.   (setvar "pdmode" 0)
  1102.  
  1103.   ;; The great divide
  1104.   (command "divide" sp div#)          ; make some points
  1105.   ;; in the event they ^C the divide command, here's a failsafe exit.
  1106.   (if closed
  1107.     (if (/= (sslength (ssget "p")) div#) (exit))  ; if it's a closed pline
  1108.     (if (/= (sslength (ssget "p")) (1- div#)) (exit))  ; if it's open
  1109.   )
  1110.   (setvar "cmdecho" echo)
  1111.   (setvar "pdmode" pdmode)
  1112.  
  1113.   ;; Collect and remove the divide points
  1114.   (repeat (if closed div# (1- div#))
  1115.     ;; get the point for the list
  1116.     (setq t1 (cdr (assoc 10 (entget (entlast)))))
  1117.         (if 1stpt
  1118.         (setq ptlist (list t1)
  1119.               1stpt nil
  1120.         )
  1121.         (setq ptlist (cons t1 ptlist))  ; add the point to the list
  1122.     )
  1123.     (entdel (entlast))                ; remove the point entity
  1124.   )
  1125.  
  1126.   ;; Finish off the point list
  1127.   (if (not closed)
  1128.     (setq ptlist (cons startpt ptlist))  ; add the start point
  1129.   )
  1130.  
  1131.   ;;  Return the contents of the point list
  1132.   (if revpath
  1133.     (setq ptlist (reverse ptlist))
  1134.     (setq ptlist ptlist)
  1135.   )
  1136. )
  1137.  
  1138.  
  1139. ;;;
  1140. ;;; (cname f n) - a function used to create the correct numbering for files
  1141. ;;;                f = filename,  n = number to append
  1142. (defun cname (f n)
  1143.   (cond
  1144.     ((<= n 9)   (strcat f "000" (itoa n)))
  1145.     ((<= n 99)  (strcat f "00" (itoa n)))
  1146.     ((<= n 999) (strcat f "0" (itoa n)))
  1147.     ((> n 999)  (strcat f (itoa n)))
  1148.   )
  1149. )
  1150.  
  1151.  
  1152. ;;;
  1153. ;;; (OUTPUT) -- Command used to set the output format for the kinetic routines.
  1154. ;;;
  1155. (defun output (/ a)
  1156.   (if oset
  1157.     (princ (strcat "\nCurrent output is to " oset))
  1158.     (progn
  1159.       (princ "\nCurrent output is to filmroll")
  1160.       (setq oset "filmroll"
  1161.             deed "filmroll"
  1162.             sfx ".flm"
  1163.       )
  1164.     )
  1165.   )
  1166.  
  1167.   (initget "DXF Drawing Slide Test Filmroll Exit X")
  1168.   (if (= deed "TEST")
  1169.     (setq a (getkword (strcat 
  1170.      "\nSet output format to DXF/Drawing/Filmroll/Slide/Exit <"oset">: ")
  1171.             )
  1172.     )
  1173.     (setq a (getkword (strcat 
  1174.           "\nSet output format to DXF/Drawing/Filmroll/Slide/Test <"oset">: ")
  1175.             )
  1176.     )
  1177.   )
  1178.  
  1179.   (cond
  1180.     ((= a "DXF") (setq deed "DXFOUT" sfx ".dxf" oset "DXF"))
  1181.     ((= a "Drawing") (setq deed "SAVE" sfx ".dwg" oset "Drawing"))
  1182.     ((= a "Slide") (setq deed "MSLIDE" sfx ".sld" oset "Slide"))
  1183.     ((= a "Test") (setq deed "TEST" sfx ".tst" oset "Test"))
  1184.     ((= a "Filmroll") (setq deed "FILMROLL" sfx ".flm" oset "Filmroll"))
  1185.     ((or (= a "X") (= a "Exit")) (setq deed nil sfx nil oset nil))
  1186.   )
  1187.   (if deed (princ (strcat "\nOutput format is set to " oset)))
  1188.  
  1189.   (if (= deed "MSLIDE")
  1190.     (progn
  1191.       (initget "Yes No")
  1192.       (setq seepath (getkword
  1193.              "\nWould you like the view to follow a PATH script? <N>: ")
  1194.       )
  1195.       (if (= seepath "Yes")
  1196.         (while (/= (type seepath) 'FILE)
  1197.           (setq cpath (strcat fdir (justname (getvar "dwgname")))
  1198.                  hdir fdir
  1199.                  seepath nil
  1200.           )
  1201.           (while (not seepath)
  1202.             (setq seepath (getname (strcat 
  1203.                                 "\nPath script file to use <" cpath ">: ")
  1204.                           )
  1205.                      fdir hdir
  1206.             )
  1207.             (if (not seepath)
  1208.               (prompt "\nInvalid file name, please re-enter.")
  1209.             )
  1210.           )
  1211.           (if (or (= seepath "") (null seepath)) (setq seepath cpath))
  1212.           (if (not (setq seepath (open (strcat seepath ".scr") "r")))
  1213.             (princ "\nFile not found ")
  1214.           )
  1215.         )
  1216.         ;; == seepath "No" or null
  1217.         (setq seepath nil)
  1218.       )
  1219.       (initget "Yes No")
  1220.       (setq hide (getkword "\nApply hide? <N>: "))
  1221.       (if (/= hide "Yes") (setq hide nil))
  1222.  
  1223.       ;; If Release 11, ask if they want viewport shadeing
  1224.       (initget "Yes No")
  1225.       (if (and (getvar "PLATFORM") (not hide))
  1226.         (setq sshade (getkword "\nApply AutoCAD shading? <N> "))
  1227.       )
  1228.       (if (= sshade "No")
  1229.         (setq sshade nil)
  1230.       )
  1231.  
  1232.       ;; Ask if they want to remove select polyline paths
  1233.       (initget "Yes No")
  1234.       (setq rem (getkword "\nRemove paths? <Y>: "))
  1235.       (if (= rem "No")
  1236.         (setq rem nil)
  1237.         (setq rem T)
  1238.       )
  1239.     )
  1240.   )
  1241.   (princ)
  1242. )
  1243.  
  1244. ;;;
  1245. ;;; (POLYTEST) -- Function to check for a polyline
  1246. ;;;
  1247. (defun polytest (x)                   ; x = entsel list
  1248.   (if x
  1249.     (if (and (= "POLYLINE" (cdr (assoc 0 (entget (car x)))))
  1250.              ;;see if it's a polyline and not a mesh
  1251.              (/= (logand (cdr (assoc 70 (entget (car x)))) 16) 16))
  1252.       T
  1253.       (progn
  1254.         (setq x nil)
  1255.         (princ "\nInvalid entity, please try again.")
  1256.       )
  1257.     )
  1258.   )
  1259.   (setq x x)
  1260. )
  1261.  
  1262. ;;;
  1263. ;;; (PLEN x d) -- Function used to get two points from a 
  1264. ;;;               divide process. Used for finding segment 
  1265. ;;;               and overall lengths.
  1266. ;;;               x = pline, d = divide number
  1267. ;;;
  1268. (defun plen (x d)
  1269.   (setq oce (getvar "cmdecho"))
  1270.   (setvar "cmdecho" 0)
  1271.   (command "divide" x d)
  1272.   (setq points (ssget "p"))
  1273.   (setq pt1 (getass 10 (ssname points 0))
  1274.         pt2 (getass 10 (ssname points 1))
  1275.         total (* (distance pt1 pt2) d)
  1276.   )
  1277.   (if points (command "erase" "P" ""))
  1278.   (setvar "cmdecho" oce)
  1279. )
  1280.  
  1281. ;;;
  1282. ;;; (SUPFILE a n) -- Support file function used in KINETIC 
  1283. ;;;                  and BLOCKIT to create and update support text files. 
  1284. ;;;                  a = current frame identifier n = the output file name.
  1285. ;;;
  1286. (defun supfile (a n)
  1287.   (if (= deed "SAVE")
  1288.     (setq fname (strcat n ".blt"))
  1289.     (setq fname (strcat n ".mvi")
  1290.               a (strcat a ".sld")
  1291.     )
  1292.   )
  1293.   (if (not outfile)
  1294.     (if (and (findfile (strcat fdir fname))(/= strt# 1))
  1295.       ;;add to the current file if it exists
  1296.       (progn
  1297.         (setq outfile (open (strcat fdir fname)"a") 
  1298.               appfile T
  1299.         )
  1300.         (write-line "* Appended" outfile)
  1301.       )
  1302.       (progn
  1303.         (setq outfile (open (strcat fdir fname)"w"))
  1304.         (if (= deed "SAVE")
  1305.           (write-line "* ATK Block list" outfile)
  1306.           (write-line "* ATK Slide list" outfile)
  1307.         )
  1308.       )
  1309.     )
  1310.   )
  1311.   (write-line a outfile)
  1312. )
  1313.  
  1314. ;;;
  1315. ;;; (VIEW f) -- Function used to view AutoShade script scenes as they are 
  1316. ;;;             found in the open file.  f = file to read
  1317. ;;;
  1318. (defun view (f)
  1319.   (setq search T
  1320.         vtwist "0"
  1321.   )
  1322.   (while search
  1323.     (setq rline (read-line f))
  1324.     (if rline
  1325.       (progn
  1326.         (cond
  1327.           ((= (substr rline 1 4) "lens") (setq vlens (substr rline 6)))
  1328.           ((= (substr rline 1 5) "twist") (setq vtwist (substr rline 7)))
  1329.         )
  1330.         (if (= (substr rline 1 9) ". **FRAME" )
  1331.           (progn
  1332.             (read-line f)
  1333.             (while  (/= (setq rline (read-line f)) ". *")
  1334.               (cond
  1335.                 ((= (substr rline 1 4) "lens")
  1336.                   (setq vlens (substr rline 6))
  1337.                 )
  1338.                 ((= (substr rline 1 5) "twist") 
  1339.                   (setq vtwist (substr rline 7))
  1340.                 )
  1341.                 ((= (substr rline 1 6) "target") 
  1342.                   (setq vtarg (substr rline 8))
  1343.                 )
  1344.                 ((= (substr rline 1 6) "camera")
  1345.                   (setq vcam (substr rline 8))
  1346.                 )
  1347.               )
  1348.               (setq search nil)
  1349.             )
  1350.           )
  1351.         )
  1352.       )
  1353.       (setq search nil)
  1354.     )
  1355.   )
  1356.   (if (and rline vtarg vcam vlens vtwist)
  1357.       (command "dview" "" "po" vtarg vcam "d" "" "z" vlens "tw" vtwist "")
  1358.   )
  1359. )
  1360.  
  1361. ;;;
  1362. ;;; (MOTION_STEPS) -- A function used to set start and stop points for
  1363. ;;;                  entity travel.
  1364. ;;;
  1365. (defun motion_steps ()
  1366.   (setq s# nil r# nil)
  1367.   (setq steps T)
  1368.   (while steps
  1369.     (while (not s#)
  1370.       (initget 6)
  1371.       (prompt "\n\n[Motion Range]")
  1372.       (setq s# (getint (strcat "\nStart motion at frame <1>: ")))
  1373.       (if (or (not s#) (= s# 1))      ; set default value if taken
  1374.         (setq s# 1)
  1375.         (setq s# (1- s#))
  1376.       )
  1377.       (if (> s# f#)                   ; make sure it's not too high
  1378.         (progn
  1379.           (prompt "\nExceeds total frames.")
  1380.           (setq s# nil)
  1381.         )
  1382.       )
  1383.     )                                 ; end of while steps
  1384.  
  1385.     (setq c# 0)                       ; set the count number to 0
  1386.  
  1387.     (while (not r#)                   ; do until we get a number
  1388.       (initget 6)
  1389.       (setq r# (getint (strcat 
  1390.         "\nStop motion at frame <" (itoa f#) ">: ")
  1391.                )
  1392.       )
  1393.       (if (not r#) (setq r# f#))      ; set the default if taken
  1394.       (if (> r# f#)
  1395.         (progn
  1396.           (setq r# nil)
  1397.           (prompt "\nYour motion frames are greater than the")
  1398.           (prompt "\nnumber of remaining frames, please re-enter.")
  1399.         )
  1400.       )
  1401.     )
  1402.     (cond
  1403.       ((and (/= s# 1) (= r# f#)) (setq r# (- f# (1- s#))))
  1404.       ((and (= s# 1) (/= r# f#)) T)
  1405.       ((and (/= s# 1) (/= r# f#)) (setq r# (- r# (1- s#))))
  1406.       (T (setq r# nil))
  1407.     )
  1408.     (if (= r# f#) (setq r# nil))
  1409.     (if (and r# (< r# 3))
  1410.       (progn
  1411.         (princ "\nNot enough motion frames, must be 3 at a minimum.")
  1412.         (setq steps T
  1413.               s# nil
  1414.               c# nil
  1415.               r# nil
  1416.         )
  1417.       )
  1418.       (setq steps nil)
  1419.     )
  1420.   )                                   ; end of the while steps
  1421. )
  1422.  
  1423. ;;;
  1424. ;;; (JUSTNAME x) -- Function to return just a file name, sans paths.
  1425. ;;; x = name string to sort
  1426. ;;;
  1427. (defun justname (x)
  1428.   (setq y (strlen x))
  1429.   (repeat y
  1430.     (setq z (substr x y))
  1431.     ;;Look for a path slash (or in mac's case a colon)
  1432.     (if (or (= (ascii z) 92) (= (ascii z) 47)(= (ascii z) 58))
  1433.       (setq x (substr x (1+ y))
  1434.             slash T
  1435.       )                               ; set the string
  1436.       (setq y (1- y))
  1437.     )
  1438.   )
  1439.   x                                   ; echo the change
  1440. )
  1441.  
  1442. ;;;
  1443. ;;; (GETNAME PR) -- function that returns the file name and sets a new fdir 
  1444. ;;;                if offered.
  1445. ;;; pr = prompt string to use
  1446. ;;;
  1447. (defun getname (pr / aname bname slash)
  1448.   (setq aname (getstring pr))
  1449.   (if (/= aname "")
  1450.     (progn
  1451.       (setq bname (justname aname));;get just the name
  1452.       (if slash
  1453.         ;;set a new fdir value
  1454.         (setq fdir (substr aname 1 (- (strlen aname)(strlen bname)))) 
  1455.       )
  1456.       ;;see if the directory is valid
  1457.       (if (open (strcat fdir "00ATK00") "w")       
  1458.         (setq aname bname)
  1459.         (progn
  1460.           (setq aname nil
  1461.                 fdir nil              ; clear the fdir setting
  1462.           )                           ; return nil if it isn't
  1463.           (getdir)                    ; reset fdir to previous setting
  1464.         )
  1465.       )
  1466.     )
  1467.   )
  1468.   aname
  1469. )  
  1470.  
  1471. ;;;
  1472. ;;; (GETDIR) -- a function for setting the current file storage directory
  1473. ;;;
  1474. (defun getdir ()
  1475.   (setq atkblk (ssget "x" '((2 . "ATKSETUP"))))
  1476.   (if atkblk
  1477.     (progn
  1478.       (if (> (sslength atkblk) 1)
  1479.        (progn
  1480.          (setq atkblk nil)
  1481.          (while (not atkblk)
  1482.            (setq atkblk (car 
  1483.                           (entsel "\nPlease select ATK Setup to edit: ")
  1484.                         )
  1485.            )
  1486.            (if atkblk 
  1487.              (if (/= "ATKSETUP" (cdr (assoc 2 (entget atkblk))))
  1488.                 (setq atkblk nil)
  1489.              )
  1490.            )
  1491.          )
  1492.        )
  1493.        (setq atkblk (ssname atkblk 0))
  1494.       )
  1495.       (atkread atkblk)
  1496.     )
  1497.     (setq fdir (getvar "dwgprefix"))
  1498.   )
  1499.   (princ)
  1500. )
  1501.  
  1502. ;;;
  1503. ;;; ATKread, where all data come from!
  1504. ;;;
  1505. (defun ATKREAD (x)
  1506.   ;; Start the ball rolling.
  1507.  
  1508.   (setq att (entnext (entnext x)))
  1509.    
  1510.   ;; File storage 
  1511.   (while (= (getass 0 att) "ATTRIB") 
  1512.     (setq attrib (getass 2 att))
  1513.     (cond
  1514.       ((= attrib "FDIR")(doDIR))
  1515.               
  1516.       ;; Filmroll name - dwg_name
  1517.       ((= attrib "DWG_NAME") (doNM))
  1518.         
  1519.       ;; AutoShade scene to use
  1520.       ((= attrib "SCENE") (doSC))
  1521.   
  1522.       ;; Lens / Zoom information.
  1523.       ((= attrib "CLENS") (doLNS))
  1524.         
  1525.       ;; Twist information
  1526.       ((= attrib "TWIST") (doTW))
  1527.        
  1528.       ;; Intersection toggle
  1529.       ((= attrib "INTS") (doINT))
  1530.    
  1531.       ;; Smooth toggle
  1532.       ((= attrib "SMOOTH") (doSM))
  1533.   
  1534.       ;; Background color
  1535.       ((= attrib "BCOLOR") (doBC))
  1536.   
  1537.       ;; Shade type settings
  1538.       ((= attrib "SHT") (doSHT))
  1539.    
  1540.       ;; Hardcopy or Record setting
  1541.       ((= attrib "RECORD") (doREC))
  1542.      
  1543.       ;; Rib name
  1544.       ((= attrib "RIBNAME") (doRIB))   
  1545.   
  1546.       ;; RenderMan output destination
  1547.       ((= attrib "ROUTPUT")
  1548.         (setq routput (strcase (getass 1 att)1)) 
  1549.       )      
  1550.   
  1551.       ;; Image resolution and aspect ratio
  1552.       ((= attrib "IMAGEREZ") (doIM))
  1553.   
  1554.       ;; Pixel Samples
  1555.       ((= attrib "PIXSAMP") (doPS))
  1556.    
  1557.       ;; Shadow toggle   
  1558.       ((= attrib "SHADOWS") (doSHD))  
  1559.     
  1560.     )                                 ; end of the cond
  1561.     (setq att (entnext att))
  1562.   )                                   ; end of the while
  1563.   
  1564.   ;; end of the line
  1565.   (princ)
  1566. )
  1567.  
  1568. ;;;
  1569. ;;; (dodir) - ATKRead function
  1570. ;;;
  1571. (defun doDIR ()
  1572.   (setq fdir (getass 1 att))
  1573.   (if (and (/= (substr fdir (strlen fdir) 1) "\\")
  1574.            (/= (substr fdir (strlen fdir) 1) "/"))
  1575.     (setq fdir (strcat fdir "/"))
  1576.   )
  1577.   (if (not (open (strcat fdir "00ATK00") "w"))
  1578.       (atk_reset "File Storage" (getvar "dwgprefix"))   
  1579.   )
  1580. )
  1581.  
  1582. ;;;
  1583. ;;; (doname)
  1584. ;;;
  1585. (defun doNM ()
  1586.   (setq dwg_name (getass 1 att))
  1587.   (if (> (strlen dwg_name) 8)
  1588.     (progn
  1589.       (setq entlist (subst (cons 1 (substr dwg_name 1 8)) 
  1590.                            (assoc 1 entlist) entlist))
  1591.       (entmod entlist)
  1592.     )
  1593.   )
  1594. )  
  1595.  
  1596. ;;;
  1597. ;;; (doSC)
  1598. ;;;
  1599. (defun doSC ()
  1600.   (setq scene (getass 1 att))
  1601.   (if (= (strcase scene) "NONE")
  1602.     (setq scene "None")
  1603.   )
  1604. )
  1605.  
  1606. ;;;
  1607. ;;; (doLNS)
  1608. ;;;
  1609. (defun doLNS ()
  1610.   (setq Clens (getass 1 att))         ; get the lens attribute
  1611.   (if (= (type (read Clens)) 'SYM)    ; see if it's a zoom process
  1612.     (progn
  1613.       ;;get the first value
  1614.       (setq lens_s (comma Clens)  
  1615.             ;;get the second value   
  1616.             lens_e (substr clens (+ (strlen lens_s) 2)) 
  1617.             
  1618.             ;;convert values from strings to reals or ints
  1619.             lens_s (read lens_s)
  1620.             lens_e (read lens_e)  
  1621.             
  1622.             ;; Set clens flag to "Zoom" for other routines.
  1623.             Clens  "Zoom"
  1624.       )
  1625.       ;;check for something wrong
  1626.       (if (or (= lens_s lens_e) 
  1627.               (= (type lens_e) 'SYM)
  1628.               (= (type lens_s) 'SYM)
  1629.               (<= lens_e 0) 
  1630.               (<= lens_s 0))  
  1631.         (progn
  1632.           (atk_reset "Lens length" "30")
  1633.           (setq Clens nil)
  1634.         )
  1635.         (setq lens_s (float lens_s)
  1636.               lens_e (float lens_e)
  1637.         )
  1638.       )
  1639.     )
  1640.     (progn
  1641.       (setq Clens (read Clens))       ; convert Clens from a string 
  1642.       (if (<= Clens 0)
  1643.         (atk_reset "Lens length" "30")
  1644.       )
  1645.     )
  1646.   )
  1647. )
  1648.  
  1649. ;;;
  1650. ;;; (doTW)
  1651. ;;;
  1652. (defun doTW ()
  1653.   (setq twist (getass 1 att))         ; get the twist info
  1654.   (if (/= (strcase twist) "NONE")     ; see if it's on
  1655.     (if (= (type (read twist)) 'SYM)  ; check for the fixed flag
  1656.       (progn
  1657.         (setq twist (read (substr twist 2))
  1658.               twfx T
  1659.         )
  1660.         (if (= (type twist) 'SYM)
  1661.           (progn 
  1662.             (atk_reset "Camera twist" "None")
  1663.             (setq twist nil)
  1664.             (entmod entlist)
  1665.           )
  1666.           (setq twist (float twist))
  1667.         )
  1668.       )
  1669.       (setq twist (float (read twist))
  1670.             twfx nil
  1671.       )
  1672.     )
  1673.     (setq twist "None")
  1674.   )
  1675. )
  1676.     
  1677. ;;;
  1678. ;;; (doINT)
  1679. ;;;
  1680. (defun doINT ()
  1681.   (setq ints (strcase (getass 1 att)))
  1682.   (cond
  1683.     ((= ints "OFF") (setq ints "No"))
  1684.     ((= ints "ON") (setq ints T))
  1685.     (T (atk_reset "Intersection" "Off"))
  1686.   )
  1687. )
  1688.   
  1689. ;;;
  1690. ;;; (doSM)
  1691. ;;;
  1692. (defun doSM ()
  1693.   (setq smooth (strcase (getass 1 att)))
  1694.   (cond
  1695.     ((= smooth "OFF") (setq smooth nil))
  1696.     ((= smooth "ON") (setq smooth T))
  1697.     (T (atk_reset "Smooth" "Off"))
  1698.   )
  1699. )
  1700.  
  1701. ;;;
  1702. ;;; (doBC)
  1703. ;;;
  1704. (defun doBC ()
  1705.   (setq bcolor (getass 1 att))
  1706.   (if (or (> (read bcolor) 255) 
  1707.           (< (read bcolor) 0)
  1708.           (/= (type (read bcolor)) 'INT))
  1709.     (atk_reset "Background color number" "0")
  1710.   )
  1711.   (if (= bcolor "0") 
  1712.     (setq bcolor nil)
  1713.   )
  1714. )
  1715.  
  1716. ;;;
  1717. ;; ;(doSHT)
  1718. ;;;
  1719. (defun doSHT ()
  1720.   (setq sht (strcase (substr (getass 1 att) 1 2)))
  1721.   (cond
  1722.     ((= sht "FU") (setq sht 1))       ; Full Shade
  1723.     ((= sht "FA") (setq sht 2))       ; Fast Shade
  1724.     ((= sht "QU") (setq sht 3))       ; Quick Shade
  1725.     ((= sht "SL") (setq sht 4))       ; Slide (AutoCAD)
  1726.     ((= sht "RE") (setq sht 5))       ; Renderman File
  1727.     (T (atk_reset "Autoshade Output" "Fullshade"))
  1728.   )
  1729. )
  1730.  
  1731. ;;;
  1732. ;;; (doREC)
  1733. ;;;
  1734. (defun doREC ()
  1735.   (setq record (strcase (substr (getass 1 att) 1 2)))
  1736.   (if (and (/= record "RE")           ; Record
  1737.            (/= record "HA")           ; Hardcopy
  1738.            (/= record "SA")           ; Save Image
  1739.            (/= record "RI"))          ; RIB (Renderman)
  1740.     (progn 
  1741.       (atk_reset "Save image with" "Record")
  1742.       (setq record nil)
  1743.     )
  1744.   )
  1745. )
  1746.   
  1747. ;;;
  1748. ;;; (doRIB)
  1749. ;;;
  1750. (defun doRIB ()
  1751.   (setq ribname (getass 1 att)) 
  1752.   (if (= (strcase ribname 1) "none")
  1753.     (setq ribname nil)
  1754.   )
  1755. )
  1756.  
  1757. ;;;
  1758. ;;; (doIM)
  1759. ;;;
  1760. (defun doIM ()
  1761.   (setq imagerez (getass 1 att)) 
  1762.  
  1763.   ;; get the X value
  1764.   (setq xrez (comma imagerez)
  1765.         imagerez (substr imagerez (+ (strlen xrez) 2))
  1766.   )
  1767.  
  1768.   ;; get the y value  
  1769.   (setq yrez (comma imagerez)
  1770.         prate (substr imagerez (+ (strlen yrez) 2))
  1771.   )
  1772.  
  1773.   ;; see if prate starts with a decimal point
  1774.   (if (= (substr prate 1 1) ".")
  1775.     (setq prate (strcat "0" prate))
  1776.   )
  1777.     
  1778.   ;; final check and reset if invalid values are found.  
  1779.   (if (or (and (/= (type (read prate)) 'REAL) (/= (type (read prate)) 'INT)) 
  1780.           (/= (type (read xrez)) 'INT)
  1781.           (/= (type (read yrez)) 'INT))
  1782.     (atk_reset "Image Resolution" "512,400,1")
  1783.     (setq imagerez (strcat xrez "," yrez))
  1784.   )
  1785. )
  1786.     
  1787. ;;;
  1788. ;;; (doPS)
  1789. ;;;
  1790. (defun doPS ()
  1791.   (setq pixsamp (getass 1 att) 
  1792.           xsamp (comma pixsamp)
  1793.           ysamp (substr pixsamp (+ (strlen xsamp) 2))
  1794.   )
  1795.   (if (= (strcase pixsamp) "NONE")
  1796.     (setq pixsamp nil)
  1797.     (if (or (/= (type (read xsamp)) 'INT) 
  1798.                 (/= (type (read ysamp)) 'INT))
  1799.       (atk_reset "Pixel samples" "2,2")
  1800.     )
  1801.   )
  1802. )
  1803.  
  1804. ;;;
  1805. ;;; (doSHD)
  1806. ;;;
  1807. (defun doSHD ()
  1808.   (setq shads (strcase (getass 1 att)))
  1809.   (cond
  1810.     ((= shads "OFF") (setq shads nil))
  1811.     ((= shads "ON") (setq shads T))
  1812.     (T (atk_reset "Shadows" "Off"))
  1813.   )
  1814. )
  1815.  
  1816.  
  1817.  
  1818. ;;;
  1819. ;;; comma - function to find the first comma in a string, 
  1820. ;;;         this returns the string preceeding the first comma.
  1821. ;;;
  1822. (defun comma (x / index ca)
  1823.   (setq index 1 ca nil)
  1824.   (while (/= "," ca)
  1825.     (setq ca (substr x index 1)       ; find the comma
  1826.           index (1+ index)      
  1827.     )
  1828.     (if (> index 20) (setq ca ","))
  1829.   )
  1830.   (substr x 1 (- index 2))
  1831. )
  1832.  
  1833. ;;;
  1834. ;;; Getass - Function that returns an association, plus sets the 
  1835. ;;;          entlist value used in ATKREAD
  1836. ;;;          x = associated number, y = entity name
  1837. ;;;
  1838. (defun getass (x y)
  1839.   (if (and x y)
  1840.     (progn
  1841.       (setq entlist (entget y)) 
  1842.       (cdr (assoc x entlist))   
  1843.     )
  1844.   )
  1845. )
  1846.  
  1847. ;;;
  1848. ;;; ATK_reset - Function used to reset the attribute value if invalid
  1849. ;;;
  1850. (defun atk_reset (a b)
  1851.   (prompt (strcat "\n" a ": Invalid entry - Reset to defaut value."))
  1852.   (setq entlist (subst (cons 1 b) (assoc 1 entlist) entlist))
  1853.   (entmod entlist)
  1854. )
  1855.  
  1856.  
  1857. ;;; end of the load
  1858.  
  1859. (princ)
  1860.  
  1861.  
  1862.  
  1863.