home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p030 / 2.ddi / AFKINET.LSP < prev    next >
Encoding:
Lisp/Scheme  |  1988-09-20  |  21.6 KB  |  629 lines
  1. ;
  2. ;       Generate cameras and scenes to
  3. ;       perform kinetic animation.
  4. ;
  5. ;       Last updated in release 1.0b
  6. ;
  7. ;       Designed and implemented by Kelvin R. Throop in May of 1987.
  8. ;
  9. ;       8/88  TLD/KWL -- Modified for Release 10.
  10. ;
  11. ;       This command takes a polyline, specifying the path and eye
  12. ;       height (from the polyline's elevation), and generates cameras
  13. ;       and scenes to walk through the model along the polyline.  It
  14. ;       simultaneously writes an AutoShade script file to generate
  15. ;       the images for each frame, and an AutoFlix command file
  16. ;       to create a movie from the frame images.  The camera's look-at
  17. ;       point can either be fixed or can be specified by a second
  18. ;       polyline, allowing either examination of a fixed point
  19. ;       from different viewpoints or a true Steadicam-type walkthrough.
  20. ;       In addition, the camera may be smoothly twisted throughout
  21. ;       the walkthrough, permitting inspection from various angles.
  22. ;
  23. ;       The generated script normally uses full shading to make the
  24. ;       images.  To change this to fast shading, or to subsequently
  25. ;       change back to full shade, use the command SHADETYPE.
  26. ;
  27.  
  28. (setq shadecmd "fullshade")
  29. (setq flixver "1.0b")
  30.  
  31. ;       SHADETYPE command.  Permits user to select fast or full shaded
  32. ;                           renderings for animation frames.
  33.  
  34. (defun C:shadetype ()
  35.         (setq prcd T)
  36.         (while prcd
  37.            (setq s (strcase (substr (getstring (strcat "\nFast shading for images? <"
  38.               (if (= shadecmd "fastshade") "Y" "N")
  39.               ">: ")) 1 1)))
  40.            (cond
  41.               ((= (strlen s) 0) (setq prcd nil))
  42.               ((= s "Y") (setq prcd nil shadecmd "fastshade"))
  43.               ((= s "N") (setq prcd nil shadecmd "fullshade"))
  44.            )
  45.         )
  46.         (princ)
  47. )
  48.  
  49. ;       Construct item name from type code B, base name, and index N
  50.  
  51. (defun cname (b n)
  52.         (strcat b bname (itoa n))
  53. )
  54.  
  55. ;       ICL  -- Insert camera or light.  Presently used only for cameras
  56.  
  57. (defun icl (blkn lfxy laxy sname / scale slayer rot)
  58.         (setq scale (/ (getvar "VIEWSIZE") 9.52381))
  59.         (setq rot (* (/ 180 pi) (- (angle lfxy laxy) 1.570796)))
  60.         (setq laxy (trans laxy 1 0))
  61.         (command
  62.            "insert"
  63.               blkn
  64.               lfxy
  65.               scale
  66.               scale
  67.               (strcat "<<" (rtos rot 2 6))
  68.               sname                     ; SNAME
  69.               " "                       ; GNAME
  70.               (rtos (car laxy) 2 6)     ; LAX
  71.               (rtos (cadr laxy) 2 6)    ; LAY
  72.               (rtos (caddr laxy) 2 6)   ; LAZ
  73.         )
  74. )
  75.  
  76. ;       ISH  -- Insert scene/set/shot/whatever the heck we're calling it today
  77.  
  78. (defun ish (sname otype oname / omode slayer)
  79.         (command
  80.            "insert"
  81.               "shot"
  82.               (list '2 '2)
  83.               1                               ; No x scaling
  84.               1                               ; No y scaling
  85.               "<<0"                           ; No rotation
  86.               otype                           ; Object type
  87.               oname                           ; Object name
  88.               sname                           ; Scene name
  89.         )
  90. )
  91.  
  92. ; SLOB   Select Object
  93.  
  94. ; Selects one of the active object types.
  95. ; Won't take NULL for an answer.
  96.  
  97. ; Input:  prefix prompt
  98. ;         postfix prompt
  99. ;         Null pick ok flag
  100.  
  101. ;         Uses global objct
  102.  
  103. ; Return: entity
  104.  
  105. (defun slob (pre post nulok / prcd)
  106.  
  107.   (setq prcd 1)
  108.  
  109. ;   Select the object to update.
  110.  
  111.   (while (= 1 prcd)
  112.      (setq ename (car (entsel (strcat pre (strcase objct t) post))))
  113.      (if ename
  114.         (if (= (cdr (assoc '0 (setq elist (entget ename)))) "INSERT")
  115.            (progn
  116.               (setq bnam (cdr (assoc '2 elist)))
  117.               (cond
  118.                  ; Inserted block must have the desired object name.
  119.                  ((or
  120.                     (= objct bnam)
  121.                     (and (= bnam "DIRECT") (= objct "LIGHT"))
  122.                     (and (= bnam "OVERHEAD") (= objct "LIGHT"))
  123.                     (and (= bnam "SHOT") (= objct "SCENE")))
  124.                     (setq prcd nil)
  125.                  )
  126.                  (T
  127.                     (prompt (strcat "\nSelected object is not a "
  128.                        (strcase objct t) " \n")))
  129.               )
  130.            )
  131.         )
  132.         (if nulok
  133.            (setq prcd nil))
  134.      )
  135.   )
  136.   ename
  137. )
  138.  
  139. ; bget (ename)
  140.  
  141. ; Starting at ENAME entity name it searches the database for an SEQEND
  142. ; entity . The following list is returned:
  143.  
  144. ;   (elist0   elist1   elist2   ...   elistN), where
  145.  
  146. ;      elist0    Is the block's entity list
  147.  
  148. ;      elist<i>, i=1,N are the entities lists of the block's attributes
  149.  
  150. ; If the desired INSERT entity is not found nil is returned
  151.  
  152. ; Input:  ename     - Where to start the search.
  153.  
  154. ; Return: blist     - A global value
  155.  
  156. (defun bget ( ename / prcd elist)
  157.  
  158.   (setq prcd 1)
  159.  
  160. ; Before starting, see if the current blist contains
  161. ; the desired entity.
  162.  
  163.   (cond
  164.      ((and (listp 'blist) (= ename (cdr (assoc '-1 (car blist)))))
  165.         (ename))
  166.  
  167.      (T
  168.         (setq blist (list (entget ename)))
  169.         (while prcd
  170.            (setq elist (entget (setq ename (entnext ename))))
  171.            (if (= (cdr (assoc '0 elist)) "SEQEND")
  172.              (setq prcd nil)
  173.              (setq blist (append blist (list elist)))
  174.            )
  175.         )
  176.         (cdr (assoc '-1 (car blist)))
  177.      )
  178.   )
  179. )
  180.  
  181. ; eget ( tagn )
  182.  
  183. ; Searches the current blist for an ATTRIB elist with an attribute
  184. ; tag equal to the argument's tag name. It returns either the
  185. ; attribute's elist or nil.
  186.  
  187. ; Input:  tagn      - The attribute tag name
  188. ;         blist     - A global list containing the elists to be
  189. ;                     searched.
  190. ;
  191. ; Return: elist     - The desired entity list or nil
  192.  
  193. (defun eget ( tagn / elist wlist)
  194.  
  195.   (setq elist nil)
  196.   (foreach wlist blist
  197.      (if (and (= (cdr (assoc '0 wlist)) "ATTRIB")
  198.               (= (cdr (assoc '2 wlist)) tagn)
  199.          )
  200.         (setq elist wlist)
  201.      )
  202.   )
  203.   elist
  204. )
  205.  
  206. ;       GETZ  --  Obtain elevation defaulting to current elevation
  207.  
  208. (defun getz (s / z)
  209.         (setq z (getreal (strcat s " elevation <"
  210.            (rtos (getvar "elevation")) ">: ")))
  211.         (if (null z)
  212.            (setq z (getvar "elevation"))
  213.         )
  214.         z
  215. )
  216.  
  217. ;       DIVPL  --  Divide polyline into n animation steps.  One
  218. ;                  step is placed at the start and one at the
  219. ;                  end of the polyline, and n - 2 in the middle.
  220. ;                  For historical reasons, DIVPL is called with
  221. ;                  1 one greater than the number of points desired.
  222.  
  223.       (defun divpl (p n / e op tda tdb)
  224.         (if (setq op (= 0 (logand 1 (cdr (assoc 70 (entget (car p)))))))
  225.            (progn
  226.               (setq tda
  227.                  (trans (cdr (assoc 10 (entget (entnext (car p))))) (car p) 1)
  228.               )
  229.               (command "point" (list (car tda) (cadr tda)))
  230.            )
  231.         )
  232.         (command "divide" p (- n (if op 2 1)))
  233.         (if op (progn
  234.            (setq e (car p))
  235.            (while (/= "SEQEND" (cdr (assoc 0 (entget (entnext e)))))
  236.               (setq e (entnext e))
  237.            )
  238.            (setq tdb (trans (cdr (assoc 10 (entget e))) e 1))
  239.            (command "point" (list (car tdb) (cadr tdb)))
  240.         ))
  241. )
  242.  
  243. ;       UCSP -- Check for UCS-parallel entities
  244. ;
  245. ;               Input is extrusion vector.
  246. ;               Returns T if UCS-parallel, nil if not.
  247.  
  248. (defun ucsp (edir / udir arbval dx dy dz)
  249.    (setq udir   (trans '(0 0 1) 1 0 t)
  250.          dx     (- (car edir) (car udir))
  251.          dy     (- (cadr edir) (cadr udir))
  252.          dz     (- (caddr edir) (caddr udir))
  253.          arbval (/ 1.0 64.0)
  254.    )
  255.    (if (< (+ (* dx dx) (* dy dy) (* dz dz)) 1E-20)
  256.       (equal (and (< (abs (car edir)) arbval) (< (abs (cadr edir))))
  257.              (and (< (abs (car udir)) arbval) (< (abs (cadr udir))))
  258.       )
  259.       nil
  260.    )
  261. )
  262.  
  263.  
  264. ;       ANIMLENS  --  Specify nonstandard lens focal length for kinetic
  265. ;                     animation.  Causes ANIMATE to generate a "lens"
  266. ;                     script command for every frame.
  267.  
  268. (setq animlens nil)
  269. (defun C:animlens ()
  270.         (setq animlens nil)
  271.         (initget (+ 2 4))
  272.         (setq animlens
  273.            (getreal "\nAnimation lens focal length in mm <50>: "))
  274.         (princ)
  275. )
  276.  
  277. ;       ANIMATE  --  Kinetic animation command.  Writes one filmroll
  278. ;                    per frame.
  279.  
  280. (defun C:animate ( / tdc tdd tde tdf)
  281.         (setq prcd t)
  282.         (while prcd
  283.            (setq e (entsel "\nChoose camera path polyline: "))
  284.            (if (and e
  285.                     (= (cdr (assoc 0 (entget (car e)))) "POLYLINE")
  286.                     (< (cdr (assoc 70 (entget (car e)))) 8)
  287.                )
  288.                (if (null (assoc 210 (entget (car e))))
  289.                    (if (ucsp (trans '(0 0 1) (car e) 0 T))
  290.                       (setq prcd nil)
  291.                       (princ "\n2D polyline must be UCS-parallel!\n")
  292.                    )
  293.                    (if (ucsp (cdr (assoc 210 (entget (car e)))))
  294.                        (setq prcd nil)
  295.                        (princ "\n2D polyline must be UCS-parallel!\n")
  296.                    )
  297.                )
  298.                (princ "\nMust be a 2D polyline!\n")
  299.            )
  300.         )
  301.         (setq ep nil)
  302.         (initget (+ 1 8 16) "Path Same")
  303.         (setq samef nil)
  304.         (setq laxy (getpoint "\nChoose look-at point (or Path or Same): "))
  305.         (if (= laxy "Path")
  306.            (progn
  307.               (setq prcd t)
  308.               (while prcd
  309.                  (setq ep (entsel "\nChoose look-at path polyline: "))
  310.                  (if (and ep
  311.                           (= (cdr (assoc 0 (entget (car ep)))) "POLYLINE")
  312.                           (< (cdr (assoc 70 (entget (car ep)))) 8)
  313.                      )
  314.                      (if (null (assoc 210 (entget (car ep))))
  315.                          (if (ucsp (trans '(0 0 1) (car ep) 0 T))
  316.                             (setq prcd nil)
  317.                             (princ "\n2D polyline must be UCS-parallel!\n")
  318.                          )
  319.                          (if (ucsp (cdr (assoc 210 (entget (car ep)))))
  320.                              (setq prcd nil)
  321.                              (princ "\n2D polyline must be UCS-parallel!\n")
  322.                          )
  323.                      )
  324.                      (princ "\nMust be a 2D polyline!\n")
  325.                  )
  326.               )
  327.               (setq piz (getz "\nInitial path"))
  328.               (setq pfz (getz "\nFinal path"))
  329.            )
  330.            (if (= laxy "Same")
  331.               (setq samef t)
  332.            )
  333.         )
  334.  
  335.         (setq llist nil bname nil)
  336.         (while (null bname)
  337.            (setq bname (getstring "\nBase name for path (1-3 characters): "))
  338.            (if (or (< (strlen bname) 1) (> (strlen bname) 3))
  339.               (progn
  340.                  (princ
  341.                   "Base name null or too long.  Must be 1 to 3 characters.\n")
  342.                  (setq bname nil)
  343.               )
  344.            )
  345.         )
  346.         (initget (+ 1 2 4))
  347.         (setq np (getint "\nNumber of frames: "))
  348.         (if (< np 3)
  349.            (progn
  350.               (setq np 3)
  351.               (princ "Frames set to minimum: 3\n")
  352.            )
  353.         )
  354.         (setq iz (getz "\nInitial camera"))
  355.         (setq fz (getz "\nFinal camera"))
  356.         (setq twist (getreal "\nTwist revolutions <0>: "))
  357.         (setq motl nil motrot nil motzt nil prcd t)
  358.         (while prcd
  359.            (if (> (strlen (setq ml (getstring "\nLayer to move: "))) 0)
  360.               (progn
  361.                  (if (and (tblsearch "layer" ml) (ssget "X"
  362.                             (list (cons 8 ml))))
  363.                     (progn
  364.                        (setq prcd1 t)
  365.                        (while prcd1
  366.                           (setq mlp (entsel (strcat
  367.                              "\nChoose motion path polyline for " ml ": ")))
  368.                           (if (and mlp
  369.                                    (= (cdr (assoc 0 (entget
  370.                                        (car mlp)))) "POLYLINE")
  371.                                    (< (cdr (assoc 70 (entget (car mlp)))) 8)
  372.                               )
  373.                               (if (null (assoc 210 (entget (car mlp))))
  374.                                   (if (ucsp (trans '(0 0 1) (car mlp) 0 T))
  375.                                      (setq prcd1 nil)
  376.                                      (princ "\n2D polyline must be UCS-parallel!\n")
  377.                                   )
  378.                                   (if (ucsp (cdr (assoc 210 (entget (car mlp)))))
  379.                                       (setq prcd1 nil)
  380.                                       (princ "\n2D polyline must be UCS-parallel!\n")
  381.                                   )
  382.                               )
  383.                               (princ "\nMust be a 2D polyline!\n")
  384.                           )
  385.                        )
  386.                        (setq motl (append motl (list (list ml mlp))))
  387.                        (if (setq mrz (getreal "\nRotations <0>: "))
  388.                           (setq motrot (append motrot (list
  389.                              (/ (* 360.0 mrz) np))))
  390.                           (setq motrot (append motrot '(0)))
  391.                        )
  392.                        (if (setq mrz (getreal "\nZ translation <0>: "))
  393.                           (setq motzt (append motzt (list
  394.                              (/ mrz np))))
  395.                           (setq motzt (append motzt '(0)))
  396.                        )
  397.                     )
  398.                     (prompt "No such layer in drawing or layer empty.\n")
  399.                  )
  400.               )
  401.               (setq prcd nil)
  402.            )
  403.         )
  404.  
  405. ;       Acquire the names of the lights to be used in this picture
  406. ;       by letting the user select them.
  407.  
  408.         (setq objct "LIGHT")
  409.         (while (or (null llist) lname)
  410.            (setq lname (slob "\nSelect a " ": " T))
  411.  
  412. ;          Include the light name in the list of
  413. ;          objects which belong to the scene. Don't
  414. ;          do it if the light is already part of the
  415. ;          scene.
  416.  
  417.            (if lname
  418.               (progn
  419.                  (bget lname)
  420.                  (setq lname (cdr (assoc '1 (eget "SNAME"))))
  421.                  (prompt (strcat " " lname "\n"))
  422.                  (if (not (member lname llist))
  423.                     (setq
  424.                        llist (cons lname llist)
  425.                     )
  426.                     (prompt (strcat "\nLight " lname " already selected.\n"))
  427.                  )
  428.               )
  429.            )
  430.         )
  431.  
  432.         (setq cmdo (getvar "CMDECHO"))
  433.         (setvar "CMDECHO" 0)
  434.         (setq blippo (getvar "BLIPMODE"))
  435.         (setvar "BLIPMODE" 0)
  436.  
  437.         (setq slayer (getvar "CLAYER"))
  438.         (command "LAYER" "MAKE" "$$DOTS" "")
  439.         (command "point" '(0 0))
  440.         (setq np (1+ np))
  441.         (setq ss (entlast))
  442.         (divpl e np)
  443.         (if ep
  444.            (progn
  445.               (setq ssep (entlast))
  446.               (divpl ep np)
  447.            )
  448.         )
  449.  
  450. ;       Now walk through the motion layer list and create division
  451. ;       points on the polylines that trace object motion.
  452.  
  453.         (setq pernt 0 motp nil)
  454.         (while (< pernt (length motl))
  455.            (setq motp (append motp (list (entlast))))
  456.            (divpl (cadr (nth pernt motl)) np)
  457. ;          Sledgehammer to put all objects back at original position
  458. ;          at the end.  Admire, but don't emulate.
  459.            (setq tdf (trans (cdr (assoc 10 (entget (entnext (nth pernt motp))))) 0 1))
  460.            (command "point" (list (car tdf) (cadr tdf)))
  461.            (setq pernt (1+ pernt))
  462.         )
  463.  
  464.         (command "LAYER" "MAKE" "$$ANICAM" "")
  465.  
  466. ;       Now walk through the polyline and generate a camera and
  467. ;       a set containing it and every light named, all pointing to
  468. ;       the desired look-at point.
  469.  
  470.         (setq asf (open (strcat bname ".scr") "w"))
  471.         (setq mvf (open (strcat bname ".mvi") "w"))
  472.         (write-line "record on" asf)
  473.  
  474.         (setq pernt 1)
  475.         (setq e el)
  476.         (setq tangle 0.0)
  477.         (while (< pernt np)
  478.            (setq en (setq ss (entnext ss)))
  479.            (setq pelev (+ iz (* (- fz iz)
  480.               (/ (- pernt 1.0) (- np 2.0)))))
  481.            (if ep
  482.               (progn
  483.                  (setq tdc (cdr (assoc 10 (entget (setq ssep (entnext ssep)))))
  484.                        laxy (list
  485.                                (car tdc)
  486.                                (cadr tdc)
  487.                                (+ piz (* (- pfz piz) (/ (- pernt 1.0)(- np 2.0))))
  488.                             )
  489.                  )
  490.               )
  491.            )
  492.  
  493. ;          If look at path is same as camera path, constantly look at
  494. ;          next point (and at end, look from next to last to last
  495. ;          direction from the last point).
  496.  
  497.            (if samef
  498.               (progn
  499.                  (if (< pernt (1- np))
  500.                     (setq
  501.                        plaxy laxy
  502.                        tdd (cdr (assoc 10 (entget (entnext en))))
  503.                        laxy (list (car tdd)
  504.                                   (cadr tdd)
  505.                                   (+ iz (* (- fz iz) (/ pernt (- np 2.0))))
  506.                             )
  507.                     )
  508.                     (progn
  509.                        (setq
  510.                           tdd (cdr (assoc 10 (entget (entnext en))))
  511.                           cpxy (list (car tdd) (cadr tdd) pelev)
  512.                        )
  513.                        (setq laxy (mapcar '+ cpxy
  514.                           (mapcar '- cpxy plaxy))
  515.                        )
  516.                     )
  517.                  )
  518.               )
  519.            )
  520.            (if (= 0 (getvar "WORLDUCS"))
  521.               (setq tde (trans (cdr (assoc 10 (entget en))) 0 1))
  522.               (setq tde (cdr (assoc 10 (entget en))))
  523.            )
  524.            (icl "camera"
  525.                 (list (car tde) (cadr tde) pelev)
  526.                 laxy
  527.                 (setq tcn (cname "C" pernt))
  528.            )
  529.            (ish (setq tsn (cname "S" pernt)) "CAMERA" tcn)
  530.            (setq ll llist)
  531.            (while ll
  532.               (ish tsn "LIGHT" (car ll))
  533.               (setq ll (cdr ll))
  534.            )
  535.            (setq usn (cname "s" pernt))
  536.            (write-line (strcat "open" " " usn) asf)
  537.            (write-line (strcat "scene " usn) asf)
  538.            (write-line "spercent -1" asf)
  539.            (if animlens
  540.               (write-line (strcat "lens " (rtos animlens 2 6)) asf)
  541.            )
  542.            (if twist
  543.               (progn
  544.                  (write-line (strcat "twist " (rtos tangle 2 6)) asf)
  545.                  (setq tangle (rem (+ tangle (/ (* 360.0 twist) (- np 2.0)))
  546.                     360.0))
  547.               )
  548.            )
  549.            (command "filmroll" usn)
  550.            ; Get rid of camera and scene
  551.            (command "erase" (ssget "X" '((8 . "$$ANICAM"))) "")
  552.            (write-line (strcat shadecmd " " usn) asf)
  553.            (write-line usn mvf)
  554.  
  555. ;          Move everything into position for the next frame
  556.  
  557.            (setq motn 0 motu nil)
  558.            (while (< motn (length motl))
  559.               (setq me (entnext (nth motn motp)))
  560.               (command "move" (ssget "X" (list (cons 8
  561.                  (car (nth motn motl))))) ""
  562.                  (list (car (trans (cdr (assoc 10 (entget me))) 0 1))
  563.                        (cadr (trans (cdr (assoc 10 (entget me))) 0 1))
  564.                        0.0
  565.                  )
  566.                  (append
  567.                     (setq motbp
  568.                        (list (car (trans (cdr (assoc 10 (entget (entnext me)))) 0 1))
  569.                              (cadr (trans (cdr (assoc 10 (entget (entnext me)))) 0 1))
  570.                        )
  571.                     )
  572.                     (list (nth motn motzt))
  573.                  )
  574.               )
  575.               (setq motu (append motu (list me)))
  576.               (if (/= 0 (setq motor (nth motn motrot)))
  577.                  (command "rotate" (ssget "X" (list (cons 8
  578.                     (car (nth motn motl))))) ""
  579.                     motbp
  580.                     (strcat "<<" (rtos motor 2 6))
  581.                  )
  582.               )
  583.               (setq motn (1+ motn))
  584.            )
  585.            (setq motp motu)
  586.  
  587.            (setq pernt (1+ pernt))
  588.         )
  589.  
  590.         ; Reverse rotation and Z translation for moving objects
  591.  
  592.         (setq motn 0)
  593.         (while (< motn (length motl))
  594.            (setq me (entnext (nth motn motp)))
  595.            (command "move" (ssget "X" (list (cons 8
  596.               (car (nth motn motl))))) ""
  597.                  (list (car (trans (cdr (assoc 10 (entget me))) 0 1))
  598.                        (cadr (trans (cdr (assoc 10 (entget me))) 0 1))
  599.                        0.0
  600.                  )
  601.                  (append
  602.                     (setq motbp
  603.                        (list (car (trans (cdr (assoc 10 (entget me))) 0 1))
  604.                              (cadr (trans (cdr (assoc 10 (entget me))) 0 1))
  605.                        )
  606.                     )
  607.                     (list (* -1 (- np 1) (nth motn motzt)))
  608.                  )
  609.            )
  610.            (setq motu (append motu (list me)))
  611.            (if (/= 0 (setq motor (nth motn motrot)))
  612.               (command "rotate" (ssget "X" (list (cons 8
  613.                  (car (nth motn motl))))) ""
  614.                  motbp
  615.                  (strcat "<<" (rtos (* -1 (- np 1) motor) 2 6))
  616.               )
  617.            )
  618.            (setq motn (1+ motn))
  619.         )
  620.  
  621.         (close asf)
  622.         (close mvf)
  623.         (command "erase" (ssget "X" '((8 . "$$DOTS"))) "")
  624.         (command "LAYER" "SET" slayer "")
  625.         (setvar "BLIPMODE" blippo)
  626.         (setvar "CMDECHO" cmdo)
  627.         (princ)
  628. )
  629.