;-------------------------------------------------------------------------------
; Program Name: FireWorks.lsp [FireWorks R2] - AutoLISP graphics animation
; Created By:   Terry Miller (Email: terrycadd@yahoo.com)
;               (URL: http://web2.airmail.net/terrycad)
;               (File: http://web2.airmail.net/terrycad/LISP/FireWorks.lsp)
; Date Created: 7-1-08
; Notes:        FireWorks is an AutoLISP graphics animation program. It can be
;               run inside of an existing drawing. When it's finished, it purges
;               the layer FireWorks and all entities it created. Press P to pause
;               the animation, or press Q to quit in order to purge the layer and
;               entities it created. If you pressed the escape key to abort, you
;               can simply rerun FireWorks again and press Q to quit. So do not
;               press the escape key to abort the animation.
; Disclaimer:   This program is free to download and share and learn from. It
;               contains many useful functions that may be applied else where.
;               Every effort on my part has been to create a graphics animation
;               that will run in most versions of AutoCAD, and when finished it
;               will return to the environment before it started. FireWorks is
;               now yours to tweak, debug, add to, rename, use parts of, or create
;               another graphics animation from. It is now your responsibility
;               when, and within what drawings you should run it. If you are
;               unsure of how it may affect certain drawing environments, do a
;               saveas before running it. Do not save a drawing without running
;               FireWorks and pressing Q to quit.
;-------------------------------------------------------------------------------
; Revision History
; Rev  By     Date    Description
;-------------------------------------------------------------------------------
; 1    TM   7-1-08    Initial version.
; 2    TM   7-3-08    Revised function to use less blocks more efficiently, and
;                     added a delay between FireWorks displays.
;-------------------------------------------------------------------------------
; c:FireWorks - FireWorks AutoLISP graphics animation program
;-------------------------------------------------------------------------------
(defun c:FW()(load "FireWorks")(c:FireWorks));Shortcut
(defun c:FireWorks (/ Block$ BlockA1$ BlockA2$ BlockB1$ BlockB2$ BlockC1$ BlockC2$
  BlockD1$ BlockD2$ BlockE1$ BlockE2$ BlockF1$ BlockF2$ BlockG1$ BlockG2$ BlockH1$
  BlockH2$ BlockI1$ BlockI2$ BlockJ1$ BlockJ2$ BlockK1$ BlockK2$ BlockL1$ BlockL2$
  Blocks@ Class# Clayer$ Cnt# Cnt1# Cnt2# Cnt3# Cnt4# Cnt5# Cnt6# Cnt7# Cnt8# Cnt9#
  Cnt10# Cnt11# Cnt12# Code# Color1# Color2# Dia~ Ent1^ Ent2^ Ent3^ Ent4^ Ent5^ Ent6^
  Ent7^ Ent8^ Ent9^ Ent10^ Ent11^ Ent12^ FireWorks: HRange InsBase InsScales@ Int#
  List@ LLpt LMpt Loop LRpt MoveWorks: Moving MultiColors@ Num# Num1# Num2# Order@
  Osmode# P1 P2 P3 P4 P5 P6 P7 P8 P9 P10 P11 P12 RangeIns Read@ SingleColors@ SS&
  SubLoop Temp@ Total# ULpt UMpt Unique Unique$ UniqueName$ Uniques@ Unit~ URpt
  Value ViewCtr ViewExtents@ ViewSize~ ViewWidth~ VRange)
  ;-----------------------------------------------------------------------------
  ; FireWorks: - Draws FireWorks
  ; Arguments: 4
  ;   Ins = Insertion point
  ;   Dia~ = Diameter
  ;   Color1# = Spark color
  ;   Color2# = Trailing color
  ; Returns: Draws FireWorks and returns a list of the block names created.
  ;-----------------------------------------------------------------------------
  (defun FireWorks: (Ins Dia~ Color1# Color2# / Ang~ AngChg~ Block1$ Block2$ Block3$
    Block4$ Cen Cnt# Color3# Color4# ColorA1# ColorA2# ColorA3# ColorA4# ColorB1#
    ColorB2# ColorB3# ColorB4# Left# Len~ Num# P1 P2 P3 Rad~ Right# RndColor RndColors:
    SS1& SS2& SS3& SS4& TwoColors UniqueName$ Unit~ Vortex)
    (defun RndColors: ()
      (setq Color1# (* 10 (1+ (RndInt 23))) Color2# Color1#)
      (while (< (abs (- Color1# Color2#)) 30)
        (setq Color2# (* 10 (1+ (RndInt 23))))
      );while
      (setq Color2# (+ Color2# 4) Color3# (+ Color1# 8) Color4# (+ Color2# 5))
      (if TwoColors
        (if (IsEven (/ Cnt# 2))
          (if (not ColorB1#)
            (setq ColorB1# Color1# ColorB2# Color2# ColorB3# Color3# ColorB4# Color4#)
            (setq Color1# ColorB1# Color2# ColorB2# Color3# ColorB3# Color4# ColorB4#)
          );if
          (if (not ColorA1#)
            (setq ColorA1# Color1# ColorA2# Color2# ColorA3# Color3# ColorA4# Color4#)
            (setq Color1# ColorA1# Color2# ColorA2# Color3# ColorA3# Color4# ColorA4#)
          );if
        );if
      );if
    );defun RndColors:
    (if (not Color1#)
      (progn
        (setq RndColor t)
        (if (not Color2#)
          (setq TwoColors t)
        );if
      );progn
      (setq Color3# (+ Color1# 8) Color4# (+ Color2# 5))
    );if
    (setq Unit~ (/ Dia~ 80.0))
    (setq Vortex (polar Ins (d2r 90) (* Unit~ 9)))
    (setq Cen (polar Ins (d2r 90) (* Unit~ 9)))
    (setq SS1& (ssadd))(setq SS2& (ssadd))
    (setq SS3& (ssadd))(setq SS4& (ssadd))
    (setq Right# 4)(setq Left# 6)
    (setq Ang~ 30)(setq Num# 0)(setq Cnt# 0)(setq AngChg~ 7.5)
    ;(command "circle" Ins "d" Dia~)(command "_chprop" (entlast) "" "_c" 1 "");Uncomment while debugging
    (setq Cen (polar Cen (d2r 270) (* Unit~ 3)))
    (setq Rad~ (* Unit~ 9))
    ;(command "arc" "_c" Cen (polar Cen (d2r 30) Rad~) (polar Cen (d2r 90) Rad~));Uncomment while debugging
    (while (<= Ang~ 90)
      (setq Len~ (+ Unit~ (* Unit~ (- 2 (* 2 (/ Ang~ 90.0))))))
      (setq Len~ (* Len~ (+ 90 (1+ (RndInt 9))) 0.01));91%-100%
      (setq P1 (polar Cen (d2r Ang~) (+ (- Rad~ Len~)(* Len~ (1+ (RndInt 9)) 0.1))))
      (setq P2 (polar P1 (angle Vortex P1) (* Len~ 0.75)))
      (setq P3 (polar P2 (angle Vortex P2) (* Len~ 0.25)))
      (if RndColor (RndColors:))
      (command "_line" P1 P2 "" "_chprop" (entlast) "" "_c" Color4# "")
      (if (IsEven Cnt#)
        (ssadd (entlast) SS2&)
        (ssadd (entlast) SS4&)
      );if
      (command "_line" P2 P3 "" "_chprop" (entlast) "" "_c" Color3# "")
      (if (IsEven Cnt#)
        (ssadd (entlast) SS2&)
        (ssadd (entlast) SS4&)
      );if
      (command "_line" P1 P2 "" "_chprop" (entlast) "" "_c" Color2# "")
      (if (IsEven Cnt#)
        (ssadd (entlast) SS1&)
        (ssadd (entlast) SS3&)
      );if
      (command "_line" P2 P3 "" "_chprop" (entlast) "" "_c" Color1# "")
      (if (IsEven Cnt#)
        (ssadd (entlast) SS1&)
        (ssadd (entlast) SS3&)
      );if
      (setq Ang~ (+ Ang~ (/ 10.0 Rad~) (RndInt 5) AngChg~))
      (setq Ang~ (r2d (d2r Ang~)))
      (setq Cnt# (1+ Cnt#))
    );while
    (setq Cen (polar Ins (d2r 90) (* Unit~ 9)))
    (while (< (setq Num# (1+ Num#)) 8)
      (setq Cen (polar Cen (d2r 270) (* Unit~ 3)))
      (setq Rad~ (* Unit~ (setq Right# (+ Right# 5))))
      ;(command "arc" "_c" Cen (polar Cen (d2r 90) Rad~) (polar Cen (d2r 270) Rad~));Uncomment while debugging
      (setq AngChg~ (- AngChg~ 0.5))
      (while (<= Ang~ 270)
        (if (<= Ang~ 180)
          (setq Len~ (+ Unit~ (* Unit~ (* 2 (/ (- Ang~ 90) 90.0)))))
          (setq Len~ (+ (* Unit~ 3) (* Unit~ (* 2 (/ (- Ang~ 180) 90.0)))))
        );if
        (setq Len~ (* Len~ (+ 90 (1+ (RndInt 9))) 0.01));91%-100%
        (setq P1 (polar Cen (d2r Ang~) (+ (- Rad~ Len~)(* Len~ (1+ (RndInt 9)) 0.1))))
        (setq P2 (polar P1 (angle Vortex P1) (* Len~ 0.75)))
        (setq P3 (polar P2 (angle Vortex P2) (* Len~ 0.25)))
        (if RndColor (RndColors:))
        (command "_line" P1 P2 "" "_chprop" (entlast) "" "_c" Color4# "")
        (if (IsEven Cnt#)
          (ssadd (entlast) SS2&)
          (ssadd (entlast) SS4&)
        );if
        (command "_line" P2 P3 "" "_chprop" (entlast) "" "_c" Color3# "")
        (if (IsEven Cnt#)
          (ssadd (entlast) SS2&)
          (ssadd (entlast) SS4&)
        );if
        (command "_line" P1 P2 "" "_chprop" (entlast) "" "_c" Color2# "")
        (if (IsEven Cnt#)
          (ssadd (entlast) SS1&)
          (ssadd (entlast) SS3&)
        );if
        (command "_line" P2 P3 "" "_chprop" (entlast) "" "_c" Color1# "")
        (if (IsEven Cnt#)
          (ssadd (entlast) SS1&)
          (ssadd (entlast) SS3&)
        );if
        (setq Ang~ (+ Ang~ (/ 10.0 Rad~) (RndInt 5) AngChg~))
        (setq Ang~ (r2d (d2r Ang~)))
        (setq Cnt# (1+ Cnt#))
      );while
      (if (/= Num# 7)
        (progn
          (setq Cen (polar Cen (d2r 90) (* Unit~ 2)))
          (setq Rad~ (* Unit~ (setq Left# (+ Left# 5))))
          ;(command "arc" "_c" Cen (polar Cen (d2r 270) Rad~) (polar Cen (d2r 90) Rad~));Uncomment while debugging
          (setq AngChg~ (- AngChg~ 0.5))
          (while (or (>= Ang~ 270)(<= Ang~ 90))
            (if (<= Ang~ 90)
              (setq Len~ (+ Unit~ (* Unit~ (- 2 (* 2 (/ Ang~ 90.0))))))
              (setq Len~ (+ (* Unit~ 3) (* Unit~ (- 2 (* 2 (/ (- Ang~ 270) 90.0))))))
            );if
            (setq Len~ (* Len~ (+ 90 (1+ (RndInt 9))) 0.01));91%-100%
            (setq P1 (polar Cen (d2r Ang~) (+ (- Rad~ Len~)(* Len~ (1+ (RndInt 9)) 0.1))))
            (setq P2 (polar P1 (angle Vortex P1) (* Len~ 0.75)))
            (setq P3 (polar P2 (angle Vortex P2) (* Len~ 0.25)))
            (if RndColor (RndColors:))
            (command "_line" P1 P2 "" "_chprop" (entlast) "" "_c" Color4# "")
            (if (IsEven Cnt#)
              (ssadd (entlast) SS2&)
              (ssadd (entlast) SS4&)
            );if
            (command "_line" P2 P3 "" "_chprop" (entlast) "" "_c" Color3# "")
            (if (IsEven Cnt#)
              (ssadd (entlast) SS2&)
              (ssadd (entlast) SS4&)
            );if
            (command "_line" P1 P2 "" "_chprop" (entlast) "" "_c" Color2# "")
            (if (IsEven Cnt#)
              (ssadd (entlast) SS1&)
              (ssadd (entlast) SS3&)
            );if
            (command "_line" P2 P3 "" "_chprop" (entlast) "" "_c" Color1# "")
            (if (IsEven Cnt#)
              (ssadd (entlast) SS1&)
              (ssadd (entlast) SS3&)
            );if
            (setq Ang~ (+ Ang~ (/ 10.0 Rad~) (RndInt 5) AngChg~))
            (setq Ang~ (r2d (d2r Ang~)))
            (setq Cnt# (1+ Cnt#))
          );while
        );progn
      );if
      (setq Vortex (polar Vortex (d2r 90) (* Unit~ 2)))
    );while
    ;(command "arc" "_c" Cen (polar Cen (d2r 270) Rad~) (polar Cen (d2r 30) Rad~));Uncomment while debugging
    (setq AngChg~ (- AngChg~ 0.5))
    (while (or (>= Ang~ 270)(<= Ang~ 30))
      (if (<= Ang~ 90)
        (setq Len~ (+ Unit~ (* Unit~ (- 2 (* 2 (/ Ang~ 90.0))))))
        (setq Len~ (+ (* Unit~ 3) (* Unit~ (- 2 (* 2 (/ (- Ang~ 270) 90.0))))))
      );if
      (setq Len~ (* Len~ (+ 90 (1+ (RndInt 9))) 0.01));91%-100%
      (setq P1 (polar Cen (d2r Ang~) (+ (- Rad~ Len~)(* Len~ (1+ (RndInt 9)) 0.1))))
      (setq P2 (polar P1 (angle Vortex P1) (* Len~ 0.75)))
      (setq P3 (polar P2 (angle Vortex P2) (* Len~ 0.25)))
      (if RndColor (RndColors:))
      (command "_line" P1 P2 "" "_chprop" (entlast) "" "_c" Color4# "")
      (if (IsEven Cnt#)
        (ssadd (entlast) SS2&)
        (ssadd (entlast) SS4&)
      );if
      (command "_line" P2 P3 "" "_chprop" (entlast) "" "_c" Color3# "")
      (if (IsEven Cnt#)
        (ssadd (entlast) SS2&)
        (ssadd (entlast) SS4&)
      );if
      (command "_line" P1 P2 "" "_chprop" (entlast) "" "_c" Color2# "")
      (if (IsEven Cnt#)
        (ssadd (entlast) SS1&)
        (ssadd (entlast) SS3&)
      );if
      (command "_line" P2 P3 "" "_chprop" (entlast) "" "_c" Color1# "")
      (if (IsEven Cnt#)
        (ssadd (entlast) SS1&)
        (ssadd (entlast) SS3&)
      );if
      (setq Ang~ (+ Ang~ (/ 10.0 Rad~) (RndInt 5) AngChg~))
      (setq Ang~ (r2d (d2r Ang~)))
      (setq Cnt# (1+ Cnt#))
    );while
    ;(command "zoom" (polar Ins (d2r 270) (* Dia~ 0.55))(polar Ins (d2r 90) (* Dia~ 0.55)))(exit);Uncomment while debugging
    (setq UniqueName$ (UniqueName))
    (setq Block1$ (strcat UniqueName$ "1"))
    (command "_block" Block1$ Ins SS1& "")
    (setq Block2$ (strcat UniqueName$ "2"))
    (command "_block" Block2$ Ins SS2& "")
    (setq Block3$ (strcat UniqueName$ "3"))
    (command "_block" Block3$ Ins SS3& "")
    (setq Block4$ (strcat UniqueName$ "4"))
    (command "_block" Block4$ Ins SS4& "")
    (list Block1$ Block2$ Block3$ Block4$)
  );defun FireWorks:
  ;-----------------------------------------------------------------------------
  ; MoveWorks: - Moves FireWorks
  ; Arguments: 7
  ;   Pt = Last scaled point
  ;   EntName^ = Entity name of block
  ;   Cnt# = Counter value of FireWork
  ;   Block1$ = Exploding block name
  ;   Block2$ = Fading block name
  ;   Mirror = t or nil to mirror block
  ;   InsAngle~ = Insertion angle
  ; Returns: Moves FireWork and returns a list of the next Pt and EntName^.
  ;-----------------------------------------------------------------------------
  (defun MoveWorks: (Pt EntName^ Num# Block1$ Block2$ Mirror InsAngle~ / Dist~
    EntList@ InsPt List@ Scale1~ Scale2~)
    (if (= Num# 0)
      (progn
        (if Mirror
          (setq Scale1~ -0.1 Scale2~ 0.1)
          (setq Scale1~ 0.1 Scale2~ 0.1)
        );if
        (command "_insert" Block1$ Pt Scale1~ Scale2~ InsAngle~)
        (setq EntName^ (entlast))
      );progn
    );if
    (if (= Num# 15)
      (progn
        (setq EntList@ (entget EntName^))
        (setq InsPt (cdr (assoc 10 EntList@)))
        (setq Scale2~ (abs (cdr (assoc 41 EntList@))))
        (if Mirror
          (setq Scale1~ (* Scale2~ -1))
          (setq Scale1~ Scale2~)
        );if
        (command "_erase" EntName^ "")
        (command "_insert" Block2$ InsPt Scale1~ Scale2~ InsAngle~)
        (setq EntName^ (entlast))
      );progn
    );if
    (if (and (>= Num# 0)(< Num# (length InsScales@)))
      (progn
        (setq List@ (nth Num# InsScales@))
        (setq Scale1~ (nth 1 List@))
        (setq Dist~ (* (nth 0 List@) Dia~))
        (setq Pt (polar Pt (d2r 90) Dist~))
        (command "_scale" EntName^ "" Pt Scale1~)
      );progn
    );if
    (if (= Num# (length InsScales@))
      (command "_erase" EntName^ "")
    );if
    (list Pt EntName^)
  );defun MoveWorks:
  ;-----------------------------------------------------------------------------
  ; Start of Main Function
  ;-----------------------------------------------------------------------------
  (setq InsScales@ (list
    (list 0.00110000 1.90856943)(list 0.00449390 1.45507457)
    (list 0.00718449 1.29831044)(list 0.01030948 1.21861287)
    (list 0.01397743 1.17020200)(list 0.01832986 1.13754799)
    (list 0.02355727 1.11392604)(list 0.02992505 1.09594905)
    (list 0.03779755 1.08172391)(list 0.04769797 1.07010796)
    (list 0.06040343 1.06036909)(list 0.07709087 1.05201493)
    (list 0.09962908 1.04470041)(list 0.13111964 1.03817470)
    (list 0.17703691 1.03224916)(list 0.24777800 1.02677702)
    (list 0.36515870 1.02164006)(list 0.58168146 1.01673937)
    (list 1.05262733 1.01198870))
  );setq
  (setq Order@ (list 1 2 1 2 3 4 3 4 1 2 1 2 3 4 3 4 1 2 1 2 3 4 3 4))
  (setvar "cmdecho" 0)
  (if (/= (getvar "ctab") "Model")
    (command "_pspace")
  );if
  (command "_undo" "_begin")(gc)
  (setq ViewExtents@ (ViewExtents))
  (setq ULpt (car ViewExtents@))
  (setq LRpt (cadr ViewExtents@))
  (setq LLpt (list (car ULpt)(cadr LRpt)))
  (setq URpt (list (car LRpt)(cadr ULpt)))
  (setq ViewSize~ (getvar "viewsize"))
  (setq Unit~ (/ ViewSize~ 100.0))
  (setq ViewWidth~ (distance ULpt URpt))
  (setq ViewCtr (getvar "viewctr"))
  (setq UMpt (list (car ViewCtr)(cadr ULpt)))
  (setq LMpt (list (car ViewCtr)(cadr LLpt)))
  (setq VRange 37)
  (setq HRange (fix (/ (- ViewWidth~ (* Unit~ 56)) Unit~)))
  (if (IsEven HRange) (setq HRange (1- HRange)))
  (setq RangeIns (polar LLpt 0 (* Unit~ 28)))
  (setq RangeIns (polar RangeIns (d2r 90) (* Unit~ 47)))
  (setq InsBase (polar UMpt (d2r 90) ViewSize~))
  (setq Dia~ (* Unit~ 50))
  (setq Osmode# (getvar "osmode"))
  (setvar "osmode" 0)(setvar "blipmode" 0)
  (setq Clayer$ (getvar "clayer"))
  (if (tblsearch "layer" "FireWorks")
    (command "_layer" "_t" "FireWorks" "_u" "FireWorks" "_on" "FireWorks" "_s" "FireWorks" "")
    (command "_layer" "_m" "FireWorks" "_c" 250 "" "")
  );if
  (if (setq SS& (ssget "x" (list '(8 . "FireWorks"))))
    (command "erase" SS& "")
  );if
  (setq Block$ (strcat (substr (UniqueName) 1 5) "*"))
  (command "purge" "bl" Block$ "n")
  (repeat 40
    (princ (strcat "\n" (chr 160)));Clear Command lines
  );repeat
  (princ "\nCreating FireWorks...   1% Complete\010\010\010\010\010\010\010\010\010\010")(princ)
  (setq Class# 1 Int# 1 Total# 24)
  (while (< (length MultiColors@) 24)
    (if (IsEven Class#)
      (if (or (= Class# 2)(= Class# 6))
        (setq Color1# nil Color2# nil);Two-Colors
        (setq Color1# nil Color2# t);Multi-Colors
      );if
      (progn
        (setq Unique nil)
        (while (not Unique)
          (setq Color1# (* 10 (1+ (RndInt 23))) Color2# Color1#)
          (while (< (abs (- Color1# Color2#)) 30)
            (setq Color2# (* 10 (1+ (RndInt 23))))
          );while
          (setq Color2# (+ Color2# 4))
          (setq Unique$ (strcat (itoa Color1#) "-" (itoa Color2#)))
          (if (not (member Unique$ Uniques@))
            (progn
              (setq Uniques@ (append Uniques@ (list Unique$)))
              (setq Unique t)
            );progn
          );if
        );while
      );progn
    );if
    (setq Blocks@ (FireWorks: InsBase Dia~ Color1# Color2#))
    (if (IsEven Class#)
      (setq MultiColors@ (append MultiColors@ (list (nth 0 Blocks@) (nth 1 Blocks@))))
      (setq SingleColors@ (append SingleColors@ (list (nth 0 Blocks@) (nth 1 Blocks@))))
    );if
    (setq Class# (1+ Class#))
    (if (= Class# 9)
      (setq Class# 1)
    );if
    (setq Num# (fix (/ Int# (* Total# 0.01))))
    (cond
      ((< Num# 10)(princ "\010"))
      ((< Num# 100)(princ "\010\010"))
      ((>= Num# 100)(princ "\010\010\010"))
    );cond
    (princ (itoa Num#))(princ)
    (setq Int# (1+ Int#))
  );while
  (command "_delay" 100);Delay to show 100% Complete
  (repeat 5
    (princ (strcat "\n" (chr 160)));Clear Command lines
  );repeat
  (princ "\nFireWorks - Press P to pause, or Q to quit. ")(princ)
  (setq Loop t Class# 1)
  (while Loop
    (setq Blocks@ nil)
    (cond
      ((= Class# 1);One Single Color
        (setq Num# (* (RndInt 11) 2))
        (setq UniqueName$ (nth Num# SingleColors@))
        (setq UniqueName$ (substr UniqueName$ 1 (1- (strlen UniqueName$))))
        (foreach Int# Order@
          (setq Block$ (strcat UniqueName$ (itoa Int#)))
          (setq Blocks@ (append Blocks@ (list Block$)))
        );foreach
      );case
      ((= Class# 2);One Two-Colors
        (setq Num# (* (RndInt 5) 4))
        (setq UniqueName$ (nth Num# MultiColors@))
        (setq UniqueName$ (substr UniqueName$ 1 (1- (strlen UniqueName$))))
        (foreach Int# Order@
          (setq Block$ (strcat UniqueName$ (itoa Int#)))
          (setq Blocks@ (append Blocks@ (list Block$)))
        );foreach
      );case
      ((= Class# 3);Two Single Colors
        (setq Num1# (* (RndInt 11) 2))
        (setq SubLoop t)
        (while SubLoop
          (setq Num2# (* (RndInt 11) 2))
          (if (/= Num2# Num1#)
            (setq SubLoop nil)
          );if
        );while
        (setq Cnt# 0)
        (foreach Int# Order@
          (if (IsEven Cnt#)
            (setq Num# Num2#)
            (setq Num# Num1#)
          );if
          (setq UniqueName$ (nth Num# SingleColors@))
          (setq UniqueName$ (substr UniqueName$ 1 (1- (strlen UniqueName$))))
          (setq Block$ (strcat UniqueName$ (itoa Int#)))
          (setq Blocks@ (append Blocks@ (list Block$)))
          (setq Cnt# (1+ Cnt#))
        );foreach
      );case
      ((= Class# 4);One Multi-Colors
        (setq Num# (+ 2 (* (RndInt 5) 4)))
        (setq UniqueName$ (nth Num# MultiColors@))
        (setq UniqueName$ (substr UniqueName$ 1 (1- (strlen UniqueName$))))
        (foreach Int# Order@
          (setq Block$ (strcat UniqueName$ (itoa Int#)))
          (setq Blocks@ (append Blocks@ (list Block$)))
        );foreach
      );case
      ((= Class# 5);One Single Color
        (setq Num# (* (RndInt 11) 2))
        (setq UniqueName$ (nth Num# SingleColors@))
        (setq UniqueName$ (substr UniqueName$ 1 (1- (strlen UniqueName$))))
        (foreach Int# Order@
          (setq Block$ (strcat UniqueName$ (itoa Int#)))
          (setq Blocks@ (append Blocks@ (list Block$)))
        );foreach
      );case
      ((= Class# 6);Random Two-Colors
        (repeat 2
          (setq Temp@ List@)
          (setq List@ nil)
          (while (< (length List@) 6)
            (setq Num# (* (RndInt 5) 4))
            (if (not (member Num# List@))
              (setq List@ (append List@ (list Num#)))
            );if
          );while
          (foreach Num# List@
            (setq List@ (append List@ (list Num#)))
          );foreach
        );repeat
        (foreach Num# Temp@
          (setq List@ (append List@ (list Num#)))
        );foreach
        (setq Cnt# 0)
        (foreach Int# Order@
          (setq Num# (nth Cnt# List@))
          (setq UniqueName$ (nth Num# MultiColors@))
          (setq UniqueName$ (substr UniqueName$ 1 (1- (strlen UniqueName$))))
          (setq Block$ (strcat UniqueName$ (itoa Int#)))
          (setq Blocks@ (append Blocks@ (list Block$)))
          (setq Cnt# (1+ Cnt#))
        );foreach
      );case
      ((= Class# 7);Two Single Colors
        (setq Num1# (* (RndInt 11) 2))
        (setq SubLoop t)
        (while SubLoop
          (setq Num2# (* (RndInt 11) 2))
          (if (/= Num2# Num1#)
            (setq SubLoop nil)
          );if
        );while
        (setq Cnt# 0)
        (foreach Int# Order@
          (if (< Cnt# 4)
            (setq Num# Num2#)
            (setq Num# Num1#)
          );if
          (setq UniqueName$ (nth Num# SingleColors@))
          (setq UniqueName$ (substr UniqueName$ 1 (1- (strlen UniqueName$))))
          (setq Block$ (strcat UniqueName$ (itoa Int#)))
          (setq Blocks@ (append Blocks@ (list Block$)))
          (setq Cnt# (1+ Cnt#))
          (if (= Cnt# 8)
            (setq Cnt# 0)
          );if
        );foreach
      );case
      ((= Class# 8);Random Multi-Colors
        (repeat 2
          (setq Temp@ List@)
          (setq List@ nil)
          (while (< (length List@) 6)
            (setq Num# (+ 2 (* (RndInt 5) 4)))
            (if (not (member Num# List@))
              (setq List@ (append List@ (list Num#)))
            );if
          );while
          (foreach Num# List@
            (setq List@ (append List@ (list Num#)))
          );foreach
        );repeat
        (foreach Num# Temp@
          (setq List@ (append List@ (list Num#)))
        );foreach
        (setq Cnt# 0)
        (foreach Int# Order@
          (setq Num# (nth Cnt# List@))
          (setq UniqueName$ (nth Num# MultiColors@))
          (setq UniqueName$ (substr UniqueName$ 1 (1- (strlen UniqueName$))))
          (setq Block$ (strcat UniqueName$ (itoa Int#)))
          (setq Blocks@ (append Blocks@ (list Block$)))
          (setq Cnt# (1+ Cnt#))
        );foreach
      );case
    );cond
    (setq BlockA1$ (nth 0 Blocks@))
    (setq BlockA2$ (nth 1 Blocks@))
    (setq BlockB1$ (nth 2 Blocks@))
    (setq BlockB2$ (nth 3 Blocks@))
    (setq BlockC1$ (nth 4 Blocks@))
    (setq BlockC2$ (nth 5 Blocks@))
    (setq BlockD1$ (nth 6 Blocks@))
    (setq BlockD2$ (nth 7 Blocks@))
    (setq BlockE1$ (nth 8 Blocks@))
    (setq BlockE2$ (nth 9 Blocks@))
    (setq BlockF1$ (nth 10 Blocks@))
    (setq BlockF2$ (nth 11 Blocks@))
    (setq BlockG1$ (nth 12 Blocks@))
    (setq BlockG2$ (nth 13 Blocks@))
    (setq BlockH1$ (nth 14 Blocks@))
    (setq BlockH2$ (nth 15 Blocks@))
    (setq BlockI1$ (nth 16 Blocks@))
    (setq BlockI2$ (nth 17 Blocks@))
    (setq BlockJ1$ (nth 18 Blocks@))
    (setq BlockJ2$ (nth 19 Blocks@))
    (setq BlockK1$ (nth 20 Blocks@))
    (setq BlockK2$ (nth 21 Blocks@))
    (setq BlockL1$ (nth 22 Blocks@))
    (setq BlockL2$ (nth 23 Blocks@))
    (setq P1 (polar RangeIns 0 (* Unit~ (RndInt HRange))))
    (setq P2 (polar RangeIns 0 (* Unit~ (RndInt HRange))))
    (setq P3 (polar RangeIns 0 (* Unit~ (RndInt HRange))))
    (setq P4 (polar RangeIns 0 (* Unit~ (RndInt HRange))))
    (setq P5 (polar RangeIns 0 (* Unit~ (RndInt HRange))))
    (setq P6 (polar RangeIns 0 (* Unit~ (RndInt HRange))))
    (setq P7 (polar RangeIns 0 (* Unit~ (RndInt HRange))))
    (setq P8 (polar RangeIns 0 (* Unit~ (RndInt HRange))))
    (setq P9 (polar RangeIns 0 (* Unit~ (RndInt HRange))))
    (setq P10 (polar RangeIns 0 (* Unit~ (RndInt HRange))))
    (setq P11 (polar RangeIns 0 (* Unit~ (RndInt HRange))))
    (setq P12 (polar RangeIns 0 (* Unit~ (RndInt HRange))))
    (setq P1 (polar P1 (d2r 90) (* Unit~ (RndInt VRange))))
    (setq P2 (polar P2 (d2r 90) (* Unit~ (RndInt VRange))))
    (setq P3 (polar P3 (d2r 90) (* Unit~ (RndInt VRange))))
    (setq P4 (polar P4 (d2r 90) (* Unit~ (RndInt VRange))))
    (setq P5 (polar P5 (d2r 90) (* Unit~ (RndInt VRange))))
    (setq P6 (polar P6 (d2r 90) (* Unit~ (RndInt VRange))))
    (setq P7 (polar P7 (d2r 90) (* Unit~ (RndInt VRange))))
    (setq P8 (polar P8 (d2r 90) (* Unit~ (RndInt VRange))))
    (setq P9 (polar P9 (d2r 90) (* Unit~ (RndInt VRange))))
    (setq P10 (polar P10 (d2r 90) (* Unit~ (RndInt VRange))))
    (setq P11 (polar P11 (d2r 90) (* Unit~ (RndInt VRange))))
    (setq P12 (polar P12 (d2r 90) (* Unit~ (RndInt VRange))))
    (setq Cnt1# -1 Cnt2# (- Cnt1# 3) Cnt3# (- Cnt2# 3) Cnt4# (- Cnt3# 3)
          Cnt5# (- Cnt4# 3) Cnt6# (- Cnt5# 3) Cnt7# (- Cnt6# 3) Cnt8# (- Cnt7# 3)
          Cnt9# (- Cnt8# 3) Cnt10# (- Cnt9# 3) Cnt11# (- Cnt10# 3) Cnt12# (- Cnt11# 3)
    );setq
    (setq Moving t)
    (while Moving
      (command "_zoom" LLpt URpt)
      (command "_delay" 20);Adjust delay as needed
      (setq Read@ (grread t 12 1))
      (setq Code# (nth 0 Read@))
      (setq Value (nth 1 Read@))
      (if (and (= Code# 2)(member Value (list 80 112)));P pressed
        (progn
          (getpoint "\nFireWorks paused.  Pick mouse to continue. ")
          (repeat 5
            (princ (strcat "\n" (chr 160)));Clear Command lines
          );repeat
          (command "_zoom" LLpt URpt)
          (princ "\nFireWorks - Press P to pause, or Q to quit. ")(princ)
        );progn
      );if
      (if (and (= Code# 2)(member Value (list 81 113)));Q pressed
        (setq Moving nil Loop nil)
      );if
      (command "_zoom" LLpt URpt)
      (setq Cnt1# (1+ Cnt1#) Cnt2# (1+ Cnt2#) Cnt3# (1+ Cnt3#) Cnt4# (1+ Cnt4#)
            Cnt5# (1+ Cnt5#) Cnt6# (1+ Cnt6#) Cnt7# (1+ Cnt7#) Cnt8# (1+ Cnt8#)
            Cnt9# (1+ Cnt9#) Cnt10# (1+ Cnt10#) Cnt11# (1+ Cnt11#) Cnt12# (1+ Cnt12#)
      );setq
      (setq List@ (MoveWorks: P1 Ent1^ Cnt1# BlockA1$ BlockA2$ nil 0))
      (setq P1 (nth 0 List@) Ent1^ (nth 1 List@))
      (setq List@ (MoveWorks: P2 Ent2^ Cnt2# BlockB1$ BlockB2$ t +3))
      (setq P2 (nth 0 List@) Ent2^ (nth 1 List@))
      (setq List@ (MoveWorks: P3 Ent3^ Cnt3# BlockC1$ BlockC2$ nil 0))
      (setq P3 (nth 0 List@) Ent3^ (nth 1 List@))
      (setq List@ (MoveWorks: P4 Ent4^ Cnt4# BlockD1$ BlockD2$ t -3))
      (setq P4 (nth 0 List@) Ent4^ (nth 1 List@))
      (setq List@ (MoveWorks: P5 Ent5^ Cnt5# BlockE1$ BlockE2$ nil +3))
      (setq P5 (nth 0 List@) Ent5^ (nth 1 List@))
      (setq List@ (MoveWorks: P6 Ent6^ Cnt6# BlockF1$ BlockF2$ t 0))
      (setq P6 (nth 0 List@) Ent6^ (nth 1 List@))
      (setq List@ (MoveWorks: P7 Ent7^ Cnt7# BlockG1$ BlockG2$ nil -3))
      (setq P7 (nth 0 List@) Ent7^ (nth 1 List@))
      (setq List@ (MoveWorks: P8 Ent8^ Cnt8# BlockH1$ BlockH2$ t 0))
      (setq P8 (nth 0 List@) Ent8^ (nth 1 List@))
      (setq List@ (MoveWorks: P9 Ent9^ Cnt9# BlockI1$ BlockI2$ nil 0))
      (setq P9 (nth 0 List@) Ent9^ (nth 1 List@))
      (setq List@ (MoveWorks: P10 Ent10^ Cnt10# BlockJ1$ BlockJ2$ t +3))
      (setq P10 (nth 0 List@) Ent10^ (nth 1 List@))
      (setq List@ (MoveWorks: P11 Ent11^ Cnt11# BlockK1$ BlockK2$ nil 0))
      (setq P11 (nth 0 List@) Ent11^ (nth 1 List@))
      (setq List@ (MoveWorks: P12 Ent12^ Cnt12# BlockL1$ BlockL2$ t -3))
      (setq P12 (nth 0 List@) Ent12^ (nth 1 List@))
      (if (= Cnt12# (+ (length InsScales@) 2))
        (setq Moving nil)
      );if
    );while
    (setq Class# (1+ Class#))
    (if (= Class# 9)
      (setq Class# 1)
    );if
    (command "_delay" 200);Adjust delay between displays as needed
  );while
  (command "_undo" "_end")
  (setvar "osmode" Osmode#)
  (setvar "clayer" Clayer$)
  (if (= (getvar "clayer") "FireWorks")
    (command "_layer" "_t" "0" "_u" "0" "_on" "0" "_s" "0" "")
  );if
  (if (setq SS& (ssget "x" (list '(8 . "FireWorks"))))
    (command "_erase" SS& "")
  );if
  (setq Block$ (strcat (substr (UniqueName) 1 5) "*"))
  (command "_purge" "_bl" Block$ "_n")
  (command "_purge" "_la" "FireWorks" "_n")
  (repeat 40
    (princ (strcat "\n" (chr 160)));Clear Command lines
  );repeat
  (princ "\nFireWorks objects cleared.")
  (princ)
);defun c:FireWorks
;-------------------------------------------------------------------------------
; Start of FireWorks Support Utility Functions
;-------------------------------------------------------------------------------
; RndInt - Generates a random integer
; Arguments: 1
;   Num# = Maximum random integer number range greater than or less than 0.
; Returns: Random integer number between 0 and Num#.
;-------------------------------------------------------------------------------
(defun RndInt (Num# / Half~ Loop MaxNum# Minus PiDate$ RndNum#)
  (if (or (/= (type Num#) 'INT)(= Num# 0))
    (progn
      (princ "\nSyntax: (RndInt Num#) Num# = Maximum random integer number range\ngreater than or less than 0.")
      (exit)
    );progn
  );if
  (if (< Num# 0)
    (setq MaxNum# (abs (1- Num#)) Minus t)
    (setq MaxNum# (1+ Num#))
  );if
  (setq Half~ (/ (1- MaxNum#) 2.0))
  (if (not *RndNum*) (setq *RndNum* 10000))
  (if (not *Int*) (setq *Int* 1))
  (setq Loop t)
  (while Loop
    (if (> *Int* 50)
      (setq *Int* 1)
      (setq *Int* (1+ *Int*))
    );if
    (setq PiDate$ (rtos (* (getvar "cdate") (* pi *Int*)) 2 8))
    (cond
      ((>= MaxNum# 10000)
        (setq RndNum# (fix (* (atof (substr PiDate$ 13 5)) (* MaxNum# 0.00001))))
      )
      ((>= MaxNum# 1000)
        (setq RndNum# (fix (* (atof (substr PiDate$ 14 4)) (* MaxNum# 0.0001))))
      )
      ((>= MaxNum# 100)
        (setq RndNum# (fix (* (atof (substr PiDate$ 15 3)) (* MaxNum# 0.001))))
      )
      ((>= MaxNum# 10)
        (setq RndNum# (fix (* (atof (substr PiDate$ 16 2)) (* MaxNum# 0.01))))
      )
      ((>= MaxNum# 1)
        (setq RndNum# (fix (* (atof (substr PiDate$ 17 1)) (* MaxNum# 0.1))))
      )
      (t (setq RndNum# 0))
    );cond
    (if (or (and (< RndNum# Half~)(< *RndNum* Half~))
            (and (> RndNum# Half~)(> *RndNum* Half~)))
      (if (= (rem *Int* 2) 0)
        (setq RndNum# (- (1- MaxNum#) RndNum#))
        (if (> RndNum# Half~)
          (setq RndNum# (fix (- RndNum# Half~ 0.5)))
          (setq RndNum# (fix (+ RndNum# Half~ 0.5)))
        );if
      );if
    );if
    (if (/= RndNum# *RndNum*)
      (setq Loop nil)
    );if
  );while
  (setq *RndNum* RndNum#)
  (if Minus
    (setq RndNum# (* RndNum# -1))
  );if
  RndNum#
);defun RndInt
;-------------------------------------------------------------------------------
; IsEven - Determines if a number is even or odd
; Arguments: 1
;   Num# = Number
; Returns: t if an even number else nil if an odd number
;-------------------------------------------------------------------------------
(defun IsEven (Num#)
  (= (rem Num# 2) 0)
);defun IsEven
;-------------------------------------------------------------------------------
; d2r - Degrees to radians in the range of 0 to less than 2pi
; Arguments: 1
;   Degrees = Angle in degrees
; Returns: Radians in the range of 0 to less than 2pi.
;-------------------------------------------------------------------------------
(defun d2r (Degrees / Radians)
  (while (< Degrees 0)
    (setq Degrees (- 360 (abs Degrees)))
  );while
  (while (>= Degrees 360)
    (setq Degrees (- Degrees 360))
  );while
  (setq Radians (* pi (/ Degrees 180.0)))
  Radians
);defun d2r
;-------------------------------------------------------------------------------
; r2d - Radians to degrees in the range of 0 to less than 360 degrees
; Arguments: 1
;   Radians = Angle in radians
; Returns: Degrees in the range of 0 to less than 360 degrees.
;-------------------------------------------------------------------------------
(defun r2d (Radians / Degrees)
  (while (< Radians 0)
    (setq Radians (- (* pi 2) (abs Radians)))
  );while
  (while (>= Radians (* pi 2))
    (setq Radians (- Radians (* pi 2)))
  );while
  (setq Degrees (* 180.0 (/ Radians pi)))
  Degrees
);defun r2d
;-------------------------------------------------------------------------------
; UniqueName - Creates a unique name for temp blocks and groups
;-------------------------------------------------------------------------------
(defun UniqueName (/ Loop Name$)
  (setq Loop t)
  (while Loop
    (setq Name$ (rtos (getvar "CDATE") 2 8))
    (setq Name$ (strcat (substr Name$ 4 5)(substr Name$ 10 8)))
    (if (/= Name$ *UniqueName$)
      (setq *UniqueName$ Name$ Loop nil)
    );if
  );while
  *UniqueName$
);defun UniqueName
;-------------------------------------------------------------------------------
; ViewExtents
; Returns: List of upper left and lower right points of current view
;-------------------------------------------------------------------------------
(defun ViewExtents (/ A B C D X)
  (setq B (getvar "VIEWSIZE")
        A (* B (/ (car (getvar "SCREENSIZE")) (cadr (getvar "SCREENSIZE"))))
        X (trans (getvar "VIEWCTR") 1 2)
        C (trans (list (- (car X) (/ A 2.0)) (+ (cadr X) (/ B 2.0))) 2 1)
        D (trans (list (+ (car X) (/ A 2.0)) (- (cadr X) (/ B 2.0))) 2 1)
  );setq
  (list C D)
);defun ViewExtents
;-------------------------------------------------------------------------------
(princ);End of FireWorks.lsp