home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-385-Vol-1of3.iso / x / xshp.zip / XSHP.LSP < prev   
Text File  |  1991-01-10  |  16KB  |  600 lines
  1. ;
  2. ;Xshp.lsp
  3. ; Explodes text or shapes into plines by reading .shp file.
  4. ; Xshp can explode any text or shape entity except ones from a Big Font.
  5. ; Including ones with widths, oblique angles, thicknesses, under/over-scores
  6. ; and other special char's. Entity layers and colors are ignored.
  7. ;
  8. ; Note: Xshp assumes the .shp file can be found in the same subdirectory
  9. ;    as the .shx file. If an entity has a width or oblique angle, its
  10. ;    arc segments are broken into lines. The # of lines produced is
  11. ;    controlled by system variable SplineSegs. For my purposes, it is
  12. ;    the number of line segments in a 45 degree arc.
  13. ;
  14. ;   Copyright 1990,91 by Upper Canada Software
  15. ;   written by: Len Switzer
  16. ;        76207,254
  17. ;
  18.  
  19.  
  20. ;New *ERROR* routine.
  21. (defun ShpErr(Str)
  22.   (if ShpFH(setq ShpFH(close ShpFH)))
  23.   (setq SS nil *error* OldErr OldErr nil)
  24.   (SysVar nil nil)
  25.   (gc)
  26.   (if(/= Str"quit / exit abort")
  27.     (princ(strcat"\n oops... ERROR: "Str)))
  28.   (command)
  29.   (princ))
  30.  
  31.  
  32. ;Displace Point.
  33. ;Set new current point and pass to acad if pen is down.
  34. (defun DispPt(Pt)
  35.   (setq Pt(mapcar '*
  36.         Pt
  37.         (list(* Scale Width)Scale))
  38.     Pt(mapcar
  39.         '(lambda(Sym Pt1 Pt2)
  40.            (apply Sym (list Pt1 Pt2)))
  41.         Gen
  42.         CurPt
  43.         (list(+(car Pt)(* OblTan(cadr Pt)))
  44.           (cadr Pt))))
  45.   (if(null Rel10)
  46.     (setq Pt(polar CurPt
  47.           (cdr(assoc 50 Ent))
  48.           (distance CurPt Pt))))
  49.   (if PenDn
  50.     (command Pt)
  51.     (grdraw CurPt Pt -1))
  52.   (setq CurPt Pt))
  53.  
  54.  
  55. (defun Arc( / Dist Ang Cnt1 Cnt2 Pt1 Pt2)
  56.   (setq Center(polar '(0 0) (+ Ang1 pi) Radius))
  57.   (if(and(zerop OblTan)(eq Width 1.0))
  58.     (if PenDn
  59.       (progn
  60.     (command "A" "CE")
  61.     (if(eq Ang1 Ang2)
  62.       (progn
  63.         (DispPt Center)
  64.         (DispPt Center)
  65.         (command "CE")
  66.         (setq Ang1(- Ang1 pi))))
  67.     (DispPt (polar '(0 0) (+ Ang1 pi) Radius))
  68.     (DispPt (polar '(0 0) Ang2 Radius))
  69.     (command "L"))
  70.       (DispPt(polar Center Ang2 Radius)))
  71.     (progn
  72.       (if(and(zerop Count)
  73.        (equal Ang1 Ang2 1.0e-9))
  74.     (setq Cnt1(* pi 2))
  75.     (setq Dist(/(distance(polar Center Ang1 Radius)
  76.               (polar Center Ang2 Radius))
  77.             2)
  78.           Ang(*(atan Dist
  79.              (sqrt(-(expt Radius 2)(expt Dist 2))))
  80.            2)
  81.           Cnt1(if(equal(polar Center Ang2 Radius)
  82.                (polar Center
  83.              (apply(if Sign '- '+)(list Ang1 Ang))
  84.              Radius)
  85.                1.0e-6)
  86.             Ang
  87.             (-(* pi 2)Ang))
  88.           Cnt1(if Sign
  89.             (*(abs Cnt1)-1)
  90.             (abs Cnt1))))
  91.       (setq Cnt2(1+(fix(*(/(abs Cnt1)(/ pi 4))(getvar"SplineSegs"))))
  92.         Cnt1(/ Cnt1 Cnt2)
  93.         Pt1'(0.0 0.0))
  94.       (repeat Cnt2
  95.     (DispPt(mapcar'-
  96.          (setq Pt2(polar Center(setq Ang1(+ Ang1 Cnt1))Radius))
  97.          Pt1))
  98.     (setq Pt1 Pt2)))))
  99.  
  100.  
  101. (defun Bulge( / Dist Hgt)
  102.   (setq Temp(car ShpLst)
  103.     ShpLst(cdr ShpLst)
  104.     Sign(minusp Temp)
  105.     Temp(abs Temp)
  106.     Count 1)
  107.   (if(or(zerop Temp)(null PenDn))
  108.     (DispPt(list X Y))
  109.     (progn
  110.       (setq Dist(distance '(0 0)(list X Y))
  111.         Hgt(/(* Dist Temp)254)
  112.         Center(polar(list(/ X 2.0)(/ Y 2.0))
  113.             (apply(if Sign '-'+)
  114.                 (list(angle'(0 0)(list X Y))
  115.                   (/ pi 2)))
  116.             (/(-(expt Dist 2)(*(expt Hgt 2)4))(* Hgt 8)))
  117.         Ang1(angle Center '(0 0))
  118.         Ang2(angle Center(list X Y))
  119.         Radius(distance Center'(0 0)))
  120.       (command "A" "D"
  121.     (*(/(apply(if Sign '-'+)
  122.           (list(angle Center'(0 0))
  123.             (/ pi 2)))
  124.         pi)180))
  125.       (DispPt(list X Y))
  126.       (command "L"))))
  127.  
  128.  
  129. ;SysVar is used to save, set & restore system variables.
  130. ;Uses global SysLst to store values.
  131. ; (SysLst <Sys.Var.> <New Setting>) - Set <Sys.Var.> to <New Setting>.
  132. ;     Old value will be stored in SysLst only if there is no previous value.
  133. ; (SysLst <Sys.Var.> nil) - Restore <Sys.Var.> to old value.
  134. ; (SysLst nil nil) - Restore all settings.
  135. (defun SysVar(Sym Mode)
  136.   (cond
  137.     (Mode
  138.       (if(assoc Sym SysLst)
  139.     (if(null(cdr(assoc Sym SysLst)))
  140.       (setq SysLst(subst(cons Sym(getvar Sym))(cons Sym nil)SysLst)))
  141.     (setq SysLst(cons(cons Sym(getvar Sym))SysLst)))
  142.       (setvar Sym Mode))
  143.     (Sym
  144.       (if(and(setq Mode(assoc Sym SysLst))(cdr Mode))
  145.     (progn(setvar Sym(cdr Mode))
  146.       (setq SysLst(subst(cons Sym nil)Mode SysLst)))))
  147.     (T(foreach Mode SysLst
  148.     (if(cdr Mode)(setvar(car Mode)(cdr Mode))))
  149.       (setq SysLst nil))))
  150.  
  151.  
  152. ;Parse a number from .SHP file. Convert from hex if needed.
  153. (defun Get#( / Sign #Str Cnt Sum NumBit)
  154.   (setq Cnt 1)
  155.   (while(not(member(substr Str(setq Cnt(1+ Cnt))1)
  156.           (list","""))))
  157.   (setq #Str(substr Str 1(1- Cnt))
  158.     Str(substr Str(1+ Cnt)))
  159.   (if(eq Str"")
  160.     (if(setq Str(read-line ShpFH))
  161.       (setq Str(strcase Str))))
  162.   (if(eq(ascii #Str)40)            ;Left bracket?
  163.     (setq #Str(substr #Str 2)))
  164.   (if(eq(substr #Str(strlen #Str))"\051");Right bracket?
  165.     (setq #Str(substr #Str 1(1-(strlen #Str)))))
  166.   (if(eq(ascii #Str)45)            ;Negative?
  167.     (setq #Str(substr #Str 2)Sign"-")(setq Sign""))
  168.   (if(and(eq(ascii #Str)48)        ;Hex number?
  169.        (>(strlen #Str)1))
  170.     (progn
  171.       (setq #Str(substr #Str 2)Sum 0 NumBit(*(1-(strlen #Str))4))
  172.       (while(/= #Str"")
  173.     (setq Sum(+ Sum
  174.            (*(-(ascii #Str)(if(<(ascii #Str)58)48 55))
  175.              (expt 2 NumBit)))
  176.           #Str(substr #Str 2)NumBit(- NumBit 4)))
  177.       (if(eq Sign"")Sum(* Sum -1)))
  178.     (atoi(strcat Sign #Str))))
  179.  
  180.  
  181. (defun DrawScore(Pt1 Pt2 Mode)
  182.   (command)
  183.   (command ".Pline")
  184.   (setq CurPt(list Pt1 0)PenDn T)
  185.   (DispPt(list(/(*(cdr(assoc 40 Ent))-0.15)Scale)
  186.        (/(*(cdr(assoc 40 Ent))(if Mode 1.2 -0.2))Scale)))
  187.   (setq CurPt(list Pt2 0))
  188.   (DispPt(list(/(*(cdr(assoc 40 Ent))-0.15)Scale)
  189.        (/(*(cdr(assoc 40 Ent))(if Mode 1.2 -0.2))Scale)))
  190.   (command""))
  191.  
  192.  
  193. (defun FindShp()
  194.   (or
  195.     (setq ShpFH(open(strcat(cdr(assoc 3 Style))".shp")"r"))
  196.     (and
  197.       (setq Str(getvar"AcadPrefix"))
  198.       (while(/= Str"")
  199.         (setq Cnt 0)
  200.         (while
  201.       (not(member(substr Str(setq Cnt(1+ Cnt))1)
  202.             '(";" ""))))
  203.         (setq Str(if(setq ShpFH(open(strcat(substr Str 1(1- Cnt))
  204.                       (cdr(assoc 3 Style))".shp")
  205.                      "r"))
  206.            ""
  207.            (substr Str(1+ Cnt)))))
  208.       (cond
  209.         (ShpFH)
  210.         ((and Rel10
  211.        (setq Str(findfile(strcat(cdr(assoc 3 Style))".shp"))))
  212.       (setq ShpFH(open Str"r")))))))
  213.  
  214.  
  215. ;Reads .shp file & returns list of shape cmds for Char.
  216. ;Assumes Ent is set to text or shape entity.
  217. (defun GetShp(Char / ShpFH ShpLst Str Cnt)
  218.   (if(or(eq(cdr(assoc 0 Ent))"TEXT")
  219.        (numberp Char))
  220.     (if(or Style
  221.      (and
  222.        (setq Style(tblsearch"Style"(cdr(assoc 7 Ent))))
  223.        (FindShp)
  224.        (progn
  225.          (while(and(setq Str(read-line ShpFH))
  226.              (/=(atoi(substr Str 2))0)))
  227.          Str)
  228.        (setq Str(strcase(read-line ShpFH)))
  229.        (null(setq Above(Float(Get#))
  230.               Vert(eq(logand(cdr(assoc 70 Style))4)4)
  231.               ShpFH(close ShpFH)))))
  232.       (progn
  233.     (FindShp)
  234.     (while
  235.       (and
  236.         (progn(while(and(setq Str(read-line ShpFH))
  237.               (/=(ascii Str)42)))    ;*
  238.           Str)
  239.         (setq Str(strcase(substr Str 2)))
  240.         (princ"     \r")
  241.         (/=(princ(Get#))Char)))
  242.     (if(null Str)
  243.       (princ(strcat"\n**Character \042"(chr Char)"\042 not found in "
  244.           (strcase(cdr(assoc 3 Style)))".SHP"))))
  245.       (cond
  246.     ((null ScrFH)
  247.       (princ(strcat"\n**Can't open "(strcase(cdr(assoc 3 Style)))".SHP"))
  248.       (setq Style nil))
  249.     ((null Str)
  250.       (princ(strcat"\n**Can't find \042*0\042 character in "
  251.           (strcase(cdr(assoc 3 Style)))".SHP"))
  252.       (setq Style nil))))
  253.  
  254.       (progn
  255.     (setq Style(tblnext"Style"T)Above 1.0)
  256.     (while
  257.       (and
  258.         (progn
  259.           (while
  260.         (and
  261.           (or(zerop(logand(cdr(assoc 70 Style))1))
  262.             (eq(cdr(assoc 3 Style))""))
  263.           (setq Style(tblnext"Style"))))
  264.           Style)
  265.         (FindShp)
  266.         (while
  267.           (and
  268.         (progn
  269.           (while(and(setq Str(read-line ShpFH))(/=(ascii Str)42)))
  270.           Str)
  271.         (setq Cnt 2)
  272.         (progn
  273.           (while(not(member(substr Str(setq Cnt(1+ Cnt))1)
  274.                   '(","""))))
  275.           T)
  276.         (setq Str(substr Str(1+ Cnt))
  277.               Cnt 0)
  278.         (progn
  279.           (while(not(member(substr Str(setq Cnt(1+ Cnt))1)
  280.                   '(","""))))
  281.           T)
  282.         (princ"          \r")
  283.         (/=(princ(strcase(substr Str(1+ Cnt))))
  284.           (cdr(assoc 2 Ent)))))))
  285.     (cond
  286.       ((null Style)
  287.         (princ(strcat"\n**Shape "(cdr(assoc 2 Ent))
  288.             " not found in shape files.")))
  289.       ((null ShpFH)
  290.         (princ(strcat"\n**Can't open "(strcase(cdr(assoc 3 Style)))".SHP"))))))
  291.  
  292.   (if(and Style ShpFH)
  293.     (progn
  294.       (setq Cnt(Get#)
  295.         Str(strcase(read-line ShpFH))
  296.         Scale(/(cdr(assoc 40 Ent))Above))
  297.       (repeat(1- Cnt)
  298.     (setq ShpLst(cons(Get#)ShpLst)))
  299.       (setq ShpFH(close ShpFH))
  300.       (reverse ShpLst))
  301.     (progn
  302.       (entdel(cdr(assoc -1 Ent)))
  303.       (if ShpFH
  304.     (setq ShpFH(close ShpFH))))))
  305.  
  306.  
  307. ;Main routine.
  308. ;Draws a pline copy of Char.
  309. (defun DrawShp(Char / ShpLst PenDn Byte Temp Temp1 X Y Center
  310.               Radius Ang1 Ang2 Sign Count)
  311.  
  312.   (setq ShpLst(GetShp Char)
  313.     PenDn T)
  314.   (command)
  315.   (command".Pline"CurPt)
  316.  
  317.   ;Loop for each command in shape definition.
  318.   (while ShpLst
  319.     (setq Byte(car ShpLst)
  320.       ShpLst(cdr ShpLst))
  321.     (if(> Byte 15)
  322.  
  323.       ;Length and direction in one byte.
  324.       (progn
  325.     (setq Temp(rem Byte 16);Direction
  326.           Temp1(lsh Byte -4);Length
  327.           X(* Temp1(nth Temp(list 1.0 1.0 1.0 0.5 0.0 -0.5 -1.0 -1.0
  328.                   -1.0 -1.0 -1.0 -0.5 0.0 0.5 1.0 1.0)))
  329.           Y(* Temp1(nth Temp(list 0.0 0.5 1.0 1.0 1.0 1.0 1.0 0.5 0.0
  330.                   -0.5 -1.0 -1.0 -1.0 -1.0 -1.0 -0.5))))
  331.     (DispPt(list X Y)))
  332.  
  333.       ;Byte is a shape command from 0 to 14.
  334.       ;Nth finds corresponding code much quicker than a big cond test.
  335.       ((nth Byte(list
  336.  
  337. ;0 End of shape
  338. (lambda()
  339.   (command))
  340.  
  341. ;1 Pen down
  342. (lambda()
  343.   (setq PenDn T)
  344.   (command)
  345.   (command".Pline"CurPt))
  346.  
  347. ;2 Pen up
  348. (lambda()
  349.   (setq PenDn nil)
  350.   (command))
  351.  
  352. ;3 Divide scale
  353. (lambda()
  354.   (setq Scale(/ Scale(car ShpLst))
  355.     ShpLst(cdr ShpLst)))
  356.  
  357. ;4 Multiply scale
  358. (lambda()
  359.   (setq Scale(* Scale(car ShpLst))
  360.     ShpLst(cdr ShpLst)))
  361.  
  362. ;5 Push current location
  363. (lambda()
  364.   (setq Stack(cons CurPt Stack)))
  365.  
  366. ;6 Pop location
  367. (lambda()
  368.   (if Stack
  369.     (progn
  370.       (setq CurPt(car Stack)Stack(cdr Stack))
  371.       (if PenDn(progn(command)(command".Pline"CurPt))))
  372.     (princ"\n**More pops than pushes.")))
  373.  
  374. ;7 Draw subshape. Save current data, recursively draw subshape.
  375. (lambda()
  376.   (setq Temp(car ShpLst)
  377.     Temp1(cdr ShpLst))
  378.   (princ"  subshape:\n")
  379.   (DrawShp Temp)
  380.   (setq ShpLst Temp1))
  381.  
  382. ;8 XY displacement
  383. (lambda()
  384.   (setq X(car ShpLst)Y(cadr ShpLst)
  385.     ShpLst(cddr ShpLst))
  386.   (DispPt(list X Y)))
  387.  
  388. ;9 Multiple XY displacements
  389. (lambda()
  390.   (while(not
  391.       (and
  392.         (progn
  393.           (setq X(car ShpLst)Y(cadr ShpLst)ShpLst(cddr ShpLst))
  394.           T)
  395.         (zerop X)
  396.         (zerop Y)))
  397.     (DispPt(list X Y))))
  398.  
  399. ;10 Octant arc
  400. (lambda()
  401.   (setq Radius(car ShpLst)
  402.     Ang1(cadr ShpLst)
  403.     Sign(minusp Ang1)
  404.     ShpLst(cddr ShpLst)
  405.     Count(rem(abs Ang1)16)
  406.     Ang1(*(/(abs Ang1)16)(/ pi 4))
  407.     Ang2(if(zerop Count)
  408.           Ang1
  409.           (apply(if Sign '- '+)
  410.         (list Ang1(* Count(/ pi 4))))))
  411.   (Arc))
  412.  
  413. ;11 Fractional arc
  414. (lambda()
  415.   (setq Temp(car ShpLst)        ;Start offset.
  416.     Temp1(cadr ShpLst)        ;End offset.
  417.     Radius(+(*(caddr ShpLst)256)(cadddr ShpLst))
  418.     ShpLst(cddddr ShpLst)
  419.     Ang1(car ShpLst)        ;Start octant/Count.
  420.     ShpLst(cdr ShpLst)
  421.     Sign(minusp Ang1)
  422.     Temp(/(* Temp 45.0)256)
  423.     Temp1(/(* Temp1 45.0)256)
  424.     Count(rem(abs Ang1)16)
  425.     Ang1(*(/(abs Ang1)16)(/ pi 4))
  426.     Ang2(if(zerop Count)
  427.           (if(equal Temp Temp1 1.0e-9)
  428.         Ang1
  429.         (apply
  430.           (if Sign '+ '-)
  431.           (list Ang1(/ pi 4))))
  432.           (apply(if Sign '-'+)
  433.         (list Ang1
  434.           (*(1- Count)(/ pi 4)))))
  435.     Ang1(apply(if Sign '-'+)
  436.             (list Ang1(*(/ Temp 180)pi)))
  437.     Ang2(apply(if Sign '-'+)
  438.             (list Ang2(*(/ Temp1 180)pi))))
  439.   (Arc))
  440.  
  441. ;12 Bulge arc
  442. (lambda()
  443.   (setq X(car ShpLst)Y(cadr ShpLst)
  444.     ShpLst(cddr ShpLst))
  445.   (Bulge))
  446.  
  447. ;13 Multiple bulge arcs
  448. (lambda()
  449.   (while(not(and(setq X(car ShpLst)Y(cadr ShpLst))
  450.       (progn(setq ShpLst(cddr ShpLst))T)
  451.       (zerop X)(zerop Y)))
  452.     (Bulge)))
  453.  
  454. ;14 Vertical command. If text isn't vertical, skip next command.
  455. (lambda()
  456.   (if(null Vert)
  457.     (cond
  458.       ((null(setq Byte(car ShpLst)ShpLst(cdr ShpLst))))
  459.       ((member Byte(list 3 4 7))
  460.     (setq ShpLst(cdr ShpLst)))
  461.       ((member Byte(list 8 10 12))
  462.     (setq ShpLst(cddr ShpLst)))
  463.       ((eq Byte 11)
  464.     (setq ShpLst(cddddr ShpLst)))
  465.       ((member Byte(list 9 13))
  466.     (while(and(setq X(car ShpLst))(setq Y(cadr ShpLst))
  467.         (setq ShpLst(cddr ShpLst))
  468.         (not(and(zerop X)(zerop Y))))
  469.       (if(eq Byte 13)
  470.         (setq ShpLst(cdr ShpLst))))))))
  471.  
  472. ;15 Illegal cmd. This should never be found.
  473. (lambda()))))))
  474.  
  475.   (if ShpFH
  476.     (setq ShpFH(close ShpFH))))
  477.  
  478.  
  479.  
  480. ;Start of routine.
  481. (defun C:XShp( / SS OldErr Ent Stack Width OlbTan Gen Score Style Rel10
  482.          CurPt Text Char Cnt Str Lst Pt Pt1 Scale Above Vert)
  483.  
  484.   (princ"\nSelect text and shapes to explode.")
  485.   (setq SS(ssget)
  486.     Rel10(>=(atof(getvar"AcadVer"))10.0)
  487.     OldErr *error*
  488.     *error* ShpErr)
  489.   (SysVar"CmdEcho"0)
  490.   (SysVar"BlipMode"0)
  491.   (SysVar"GridMode"0)
  492.  
  493.   ;Loop for each entity selected.
  494.   (while(progn
  495.       ;Prune out unwanted entities.
  496.       (while(cond
  497.           ((null(setq Ent(ssname SS 0)))
  498.             nil)
  499.           ((not(member(cdr(assoc 0(setq Ent(entget Ent))))
  500.              (list"TEXT""SHAPE")))))
  501.         (ssdel(cdr(assoc -1 Ent))SS))
  502.       Ent)
  503.     (ssdel(cdr(assoc -1 Ent))SS)
  504.     (setq Width(cdr(assoc 41 Ent))
  505.       OblTan(/(sin(cdr(assoc 51 Ent)))(cos(cdr(assoc 51 Ent))))
  506.       Gen(if(assoc 71 Ent)
  507.            (list(if(eq(logand(cdr(assoc 71 Ent))2)2) '- '+)
  508.          (if(eq(logand(cdr(assoc 71 Ent))4)4) '- '+))
  509.            '(+ +))
  510.       Stack nil
  511.       Score nil
  512.       Style nil)
  513.  
  514.     ;Set start point and UCS if Release 10, and thickness.
  515.     (if Rel10
  516.       (progn(setq CurPt'(0.0 0.0))
  517.     (command)(command".ucs""e"(cdr(assoc -1 Ent))))
  518.       (setq CurPt(cdr(assoc 10 Ent))))
  519.     (entdel(cdr(assoc -1 Ent)))
  520.     (SysVar"Thickness"
  521.       (if(assoc 39 Ent)
  522.     (cdr(assoc 39 Ent))
  523.     0.0))
  524.  
  525.     (if(eq(cdr(assoc 0 Ent))"TEXT")
  526.  
  527.       (progn
  528.     (setq Text(cdr(assoc 1 Ent)))
  529.     ;Loop for each character.
  530.     (while(/= Text"")
  531.       (princ"\n")
  532.       (if(eq(substr Text 1 2)"%%")
  533.         (progn
  534.           (setq Char(strcase(substr Text 3 1))
  535.             Text(substr Text 4))
  536.           (if(member Char '("O""U""D""P""C""%"))
  537.         (cond
  538.           ((eq Char"O")
  539.             (setq Score(cons(cons T(car CurPt))Score)
  540.               Char nil))
  541.           ((eq Char"U")
  542.             (setq Score(cons(cons nil(car CurPt))Score)
  543.               Char nil))
  544.           ((eq Char"%")
  545.             (setq Char 37))
  546.           ((setq Char(cadr(assoc Char'(("D" 127)("P" 128)("C" 129)))))))
  547.         (progn
  548.           (setq Str ""
  549.             Text(strcat Char Text)
  550.             Cnt 1)
  551.           (while(and(< Cnt 4)
  552.               (not(zerop(setq Char(ascii(substr Text Cnt 1)))))
  553.               (> Char 47)(< Char 58))
  554.             (setq Str(strcat Str(chr Char))
  555.               Cnt(1+ Cnt)))
  556.           (setq Text(substr Text Cnt)
  557.             Char(atoi Str))
  558.           (if(zerop Char)
  559.             (setq Text(substr Text 2)
  560.               Char nil))))
  561.           (if Char
  562.         (DrawShp Char)))
  563.  
  564.         (progn
  565.           (DrawShp(ascii Text))
  566.           (setq Text(substr Text 2)))))
  567.  
  568.     (if Score
  569.       (progn
  570.         (setq Lst'(nil nil)Pt1 CurPt)
  571.         (foreach Pt Score
  572.           (setq CurPt Pt1)
  573.           (if(car Pt)
  574.         (if(car Lst)
  575.           (progn
  576.             (DrawScore(car Lst)(cadr Pt)T)
  577.             (setq Lst(list nil(cadr Lst))))
  578.           (setq Lst(list(cdr Pt)(cadr Lst))))
  579.         (if(cadr Lst)
  580.           (progn
  581.             (DrawScore(cadr Lst)(cadr Pt)nil)
  582.             (setq Lst(list(car Lst)nil)))
  583.           (setq Lst(list(car Lst)(cdr Pt))))))
  584.         (setq CurPt Pt1)
  585.         (if(car Lst)
  586.           (DrawScore(car Lst)(car CurPt)T))
  587.         (setq CurPt Pt1)
  588.         (if(cadr Lst)
  589.           (DrawScore(cadr Lst)(car CurPt)nil)))))
  590.  
  591.       ;Pass shape name, not ascii number.
  592.       (DrawShp(cdr(assoc 2 Ent))))
  593.  
  594.     (command)
  595.     (if Rel10
  596.       (command".ucs""p")))
  597.  
  598.   ;Use *Error* to close ShpFH and tidy up memory.
  599.   (ShpErr"quit / exit abort"))
  600.